Discussion :

[jpvba]

Bonjour chers amis du forum,


J'ai trouver sur le forum un code vraiment intéressant de monsieur Philippe Tulliez. (voir ci-dessous)


Je voudrais adapter ce code a mes besoins. Au lieu d'envoyer les données dans une feuille existante intitulé "Export", je voudrais que la procédure envoie les donnes dans une nouvelle feuille. Ainsi je pourrais faire plusieur fusion dans des onglets différentes dans le même fichier. Également il faudrait que la mise en page (longeur, hauteurs, couleur, police, etc ...) de la zone de titre sois conservé.

Je ne sais pas si je peut tous simple demander de copier les données dans une nouvelle feuille ou je risque d'Avoir des mauvaises surprise ie, les données de la premiere onglet voulu dans un nouveau fichier, les données du second dans un second, etc ...


Pour la mise en page, je n'ai vraimet pas de piste comment faire omis de faire des pastespecial qui selon mois ne serais pas optimal


Est-ce que vous avez des piste de solution afin de répondre a mes besoins ???

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Private Function ExportTable(FromSheet As Worksheet, TargetSheet As Worksheet, Optional ValueOnly As Boolean = False, Optional ClearSheet As Boolean = False, Optional ShowMsg As Boolean = True) As Long
 ' Copie données contenues ds feuille (FromSheet) vers feuille (TargetSheet)
 ' Contrainte la 1ère cellule doit être A1
 ' Auhor : Philippe Tulliez http://philippe.tulliez.be
 ' Date  : 08/01/2013 (02/01/2013)
 ' Version 1.1
 ' Update
 ' 00/00/0000-x.x
 ' Arguments
 ' FromSheet   - obj WorkSheet (Feuille d'où viennent les données)
 ' TargetSheet - obj WorkSheet (Feuille cible)
 ' [ValueOnly] - Boolean [d:FALSE] Si TRUE copie les valeurs
 ' [ClearSheet]- Boolean [d:=False] si TRUE, Fait un Clear de TargetSheet (Feuille Export)
 ' [ShowMsg]   - Boolean [d:=True] si False n'affiche pas les messages d'incohérence pour les Labels
 ' *** Déclaration ***
 ' ... Variables messages d'erreurs
 Const ver As String = "V 1.0"
 Const ErrTitle As String = "Procédure - ExportTable " & ver
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 '
 Dim c As Integer
 Dim rngTarget As Range, rngImport As Range
 Dim TargetRow As Long, depl As Integer
 Dim LabelTarget As Range, LabelImport As Range
 Dim AddressNew As String
 '
 If FromSheet.Name = TargetSheet.Name Then Exit Function ' Sortie de procédure
 '
 If ClearSheet And TargetSheet.Range("A1").CurrentRegion.count <> 1 Then TargetSheet.Cells.Clear
 '
 ' *** Assignation ***
 Set rngTarget = TargetSheet.Range("A1").CurrentRegion
 Set rngImport = FromSheet.Range("A1").CurrentRegion
 ' ... Ligne titre (Labels)
 Set LabelTarget = rngTarget.Resize(1, rngTarget.Columns.count)
 Set LabelImport = rngImport.Resize(1, rngImport.Columns.count)
 With rngTarget: TargetRow = .Rows.count + Abs(.Rows.count > 1): End With
 With TargetSheet
  AddressNew = .Range(.Cells(TargetRow, 1), .Cells(TargetRow + rngImport.Rows.count - 1, rngImport.Columns.count)).Address
 End With
 ' *** Start ***
 Select Case rngImport.Rows.count
  Case Is > 1
    depl = Abs((TargetRow > 1))
    Set rngImport = rngImport.Offset(depl).Resize(rngImport.Rows.count - depl)
    With rngImport
     Select Case True
        Case rngTarget.count = 1 ' Pas de 1ère ligne (Labels)
          .Copy TargetSheet.Range("A" & TargetRow)
          If ValueOnly Then TargetSheet.Range(AddressNew).Value = TargetSheet.Range(AddressNew).Value
          ExportTable = rngImport.Rows.count
        Case LabelTarget.count = .Resize(1, .Columns.count).count
          '
          ' Vérification si même nombre de colonne et sortie de fonction
          For c = 1 To LabelTarget.Columns.count
           If UCase(LabelTarget.Cells(1, c)) <> UCase(LabelImport.Cells(1, c)) Then
            ' Envoi du message si ShowMsg = TRUE et sortie de procédure
            If ShowMsg Then
             ErrMsg = ErrMsg _
                & vbCrLf & "Etiquette (" & LabelTarget.Cells(1, c) & ") dans feuille [Export]" _
                & vbCrLf & "Pas identique dans [" & FromSheet.Name & "] (" & LabelImport.Cells(1, c) & ")"
             MsgBox ErrMsg, vbInformation + vbOKOnly, ErrTitle
            End If
            ExportTable = rngTarget.Rows.count: Exit Function
           End If
          Next
          '
          .Copy TargetSheet.Range("A" & TargetRow) ' Copie de plage
          ExportTable = rngTarget.Rows.count + rngImport.Rows.count
          If ValueOnly Then TargetSheet.Range(AddressNew).Value = TargetSheet.Range(AddressNew).Value ' Copie Valeur
        Case Else
          ' Nombre de colonnes ds ligne titre pas identique -> Sortie de procédure
          If ShowMsg Then
           ErrMsg = ErrMsg & "Feuille : " & FromSheet.Name & vbCrLf & "Longueur ligne des titres pas identique"
           MsgBox ErrMsg, vbInformation + vbOKOnly, ErrTitle
          End If
          ExportTable = rngTarget.Rows.count: Exit Function
     End Select
    End With
 End Select
 TargetSheet.Cells.EntireColumn.AutoFit
End Function

merci du temps que vous metter a vouloir m'aider


amicalement

jp

[Philippe Tulliez]

Bonjour,

Je voudrais adapter ce code a mes besoins. Au lieu d'envoyer les données dans une feuille existante intitulé "Export", je voudrais que la procédure envoie les donnes dans une nouvelle feuille.

J'avoue être abasourdi par la question.
Soit je m'exprime très mal soit je ne suis pas assez précis dans mes explications.
A de nombreuses questions sur le même sujet dans la discussion de la contribution titrée Regrouper plusieurs feuilles sur une autre. (2003-2010), j'ai répondu que la fonction est indépendante de la feuille cible ainsi que de la feuille source donc la fonction elle même ne doit pas être modifiée.

Dans le classeur exemple téléchargeable il y a en effet une feuille nommée Export qui est la feuille cible mais ce n'est que pour l'exemple.

Il me semblait aussi que les commentaires en ligne 10 et 11 en tête de la fonction étaient clairs mais ce type de question me laisse penser le contraire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
' FromSheet   - obj WorkSheet (Feuille d'où viennent les données)
' TargetSheet - obj WorkSheet (Feuille cible)

La seule contrainte c'est que les données de la cible et de la source doivent commencer en cellule A1, que la ligne 1 doit contenir les étiquettes de colonnes et que celles-ci doivent être de même orthographe que les autres listes à regrouper.

[jpvba]

Désolé Philippe,


J'ai posté le poste avant d'avoir eu votre réponse sur l'autre poste ....


effectivement votre réponse est vraiment claire


désolé pour l'imbroglio



amicalement jp