Besoin d'aide sur un simple Paste

**Runsh63** · 01/06/2011, 15h53

Bonjour,

J'ai un fichier dans lequel je compile des données de différents onglets sur un onglet de données finales. A un moment dans ma macro je fais des copier / coller d'un onglet vers celui-ci, et je bloque sur la dernière ligne car c'est le seul champ que j'ai besoin de dupliquer deux fois, en colonne E et F.
Je pensais qu'écris comme ci-dessous c'était bon, mais le résultat est que ça va me coller les données au bon endroit en colonne E, mais ça me colle les données en F sur la 1ère cellule vide qui suit la dernière cellule en E. Par exemple ça va me coller mes données en E1:E10 et F11:F20 au lieu de ce que je souhaite, à savoir E1:F10.

Code :

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

1
2
3
4
5
6
7
8
With Sheets("Retreated AX data")
 
        .Range("A1:J" & LR2).AutoFilter Field:=10, Criteria1:="<>"
        .Range("A2:A" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("B" & PNLS)
        .Range("C2:C" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("D" & PNLS)
        .Range("H2:H" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("E" & PNLS & ":F" & PNLS)
 
    End With

Pouvez-vous m'expliquer pourquoi ça ne fonctionne pas et comment corriger SVP ?
Merci d'avance !

Cordialement,

Runsh

**mercatog** · 01/06/2011, 17h07

Bonjour
Étrange, j'ai vérifié et ça copie bien doublement sur les mêmes zones des 2 colonnes. (Code du test):

Code :

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

Sheets("Feuil1").Range("B2:B50").SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil2").Range("C4:D4")

**arosec** · 01/06/2011, 17h11

Bonjour,
Le principe me semble pourtant OK.
J'ai fait un rapide test et cela fonctionne.

Le problème ne peut il pas venir d'un autre morceau de code?

Cdt,

**Runsh63** · 06/06/2011, 12h11

Bonjour à vous,

J'ai retenté car si ça marche chez vous, j'ai fait une erreur. Malheureusement je ne vois pas où et ça ne marche toujours pas. Je vous donne donc la totalité de mon code.
Je débute en VBA, donc n'hésitez pas à m'en faire part si vous voyez des abérations, toute critique est constructive dans une démarche d'améliorations. Je précise également que c'est une macro de data-crunshing, rien à voir avec un truc de brutes comme vous devez en avoir l'habitude (désolé, c'est beaucoup de code pour pas grand chose) :

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Sub Build_ADN_FR()
 
' Compiler les données pour LCEFR
 
Application.ScreenUpdating = False
 
    'Nettoyer fichier
 
    Sheets("Retreated AX data").Cells.ClearContents
    Sheets("Retreated Infoview data").Cells.ClearContents
    Sheets("Dataloader").Cells.ClearContents
 
    'Copier / coller les données AX de l'onglet d'origine dans l'onglet de retraitement
 
    With Sheets("Original AX data")
 
    .Range("A1:" & .Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy Sheets("Retreated AX data").Range("B1")
    End With
 
 
    'Indiquer le numéro de compte sur chaque ligne
 
    With Sheets("Retreated AX data")
 
        Dim LR1 As Long, AccNumber As Range
        LR1 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
        For Each AccNumber In .Range("A2:A" & LR1)
            If AccNumber.Offset(0, 1).Value = "CPT" Then
                AccNumber.Value = AccNumber.Offset(0, 2).Value
            Else
                AccNumber.Value = AccNumber.Offset(-1, 0).Value
            End If
        Next AccNumber
 
    'Supprimer lignes inutiles
 
        Dim RToDel As Long
 
        For RToDel = LR1 To 2 Step -1
            If .Cells(RToDel, 6).Value = "Devise" Or .Cells(RToDel, 6).Value = "" Then
                .Rows(RToDel).Delete
            End If
        Next RToDel
 
    'MEF colonne des activités (SUPPRESPACE)
 
        Dim LR2 As Long, Activity As Range
        LR2 = .Cells(.Rows.Count, 1).End(xlUp).Row
 
        For Each Activity In .Range("C2:C" & LR2)
        Activity.Value = Trim(Activity.Value)
        Next Activity
 
    'Renommer les noms de champ
 
        .Range("A1:J1") = Array("Compte", "Date", "Activité", "N°document", "Libellé", "Devise", "Montant en devise", "Montant", "Cumul", "Résultat")
 
    'Calcul du résultat
 
        Dim RAX As String
 
        .Range("J2:J" & LR2).Formula = "=IF(OR(LEFT(TEXT(RC[-9],""000000""),1)=""6"",LEFT(TEXT(RC[-9],""000000""),1)=""7"",LEFT(TEXT(RC[-9],""000000""),3)=""186"",LEFT(TEXT(RC[-9],""000000""),3)=""187""),RC[-2],"""")"
        RAX = Format(WorksheetFunction.Sum(.Range("J2:J" & LR2)), "#,##.00")
        MsgBox "Source AX: Le résultat de la période est de " & RAX & " €", vbOKOnly, "Calcul du résultat"
 
    End With
 
    'Copier / coller les données Infoview de l'onglet d'origine dans l'onglet de retraitement
 
    With Sheets("Original Infoview data")
 
        Dim Matrix As Range, MStart As Range
        Set MStart = .Cells.Find("Account Number", LookIn:=xlValues)
        Set Matrix = .Range(MStart, MStart.End(xlToRight).End(xlDown))
 
            Matrix.Copy Sheets("Retreated Infoview data").Range("A1")
 
        Set MStart = Nothing
        Set Matrix = Nothing
 
    End With
 
    'Calcul du résultat Infoview
 
    With Sheets("Retreated Infoview data")
 
        Dim LR3 As Long, RI As String
        LR3 = .Cells(.Rows.Count, 1).End(xlUp).Row
 
        .Range("J2:J" & LR3).Formula = "=IF(OR(LEFT(TEXT(RC[-9],""000000""),1)=""6"",LEFT(TEXT(RC[-9],""000000""),1)=""7"",LEFT(TEXT(RC[-9],""000000""),3)=""186"",LEFT(TEXT(RC[-9],""000000""),3)=""187""),RC[-1],"""")"
        RI = Format(WorksheetFunction.Sum(.Range("J2:J" & LR3)), "#,##.00")
        MsgBox "Source Infoview: Le résultat de la période est de " & RI & " €", vbOKOnly, "Calcul du résultat"
 
 
 
    'Calcul de l'écart entre résultats AX & Infoview
 
        Dim Disc As String, Question As Integer
        Disc = Format(Round(CDbl(RAX - RI), 2), "#,##0.00")
        Question = MsgBox("La différence entre le résultat d'AX et d'Infoview est de " & Disc & " est-ce correct ?", vbYesNo + vbQuestion, "Calcul de l'écart de résultat")
        If Question = vbNo Then
            MsgBox "Erreur dans l'intégration des fichiers, veuillez recommencer la procédure depuis le début", vbCritical, "Erreur"
            End
        Else
            MsgBox "Continuer", vbOKOnly + vbInformation, "Compilation des données"
        End If
 
    End With
 
    'Compiler données finales
 
        'Copier BS
 
        With Sheets("Retreated Infoview data")
 
        .Range("A1:J" & LR3).AutoFilter Field:=10, Criteria1:="="
        .Range("A2:A" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("B2")
        .Range("I2:I" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("E2")
        .Range("I2:I" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("F2")
        .Range("A1:J" & LR3).AutoFilter
 
        End With
 
        With Sheets("Dataloader")
 
        Dim BSE As Long, PNLS As Long
        BSE = .Cells(.Rows.Count, 2).End(xlUp).Row
        PNLS = BSE + 1
 
        End With
 
        'Copier PNL
 
        With Sheets("Retreated AX data")
 
        .Range("A1:J" & LR2).AutoFilter Field:=10, Criteria1:="<>"
        .Range("A2:A" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("B" & PNLS)
        .Range("C2:C" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("D" & PNLS)
        .Range("H2:H" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("E" & PNLS & ":F" & PNLS)
        .Range("B2:B" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("G" & PNLS)
        .Range("E2:E" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("H" & PNLS)
        .Range("D2:D" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("I" & PNLS)
        .Range("A1:J" & LR2).AutoFilter
 
        End With

**mercatog** · 06/06/2011, 13h04

Bonjour

Le code est en première vue est fonctionnel, mais ça dépendra en partie de la disposition du classeurs.

J'ai retapé le code (en essayant le plus possible de se surpasser des boucles) et d'ajouter quelques tests par précaution.

A tester

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Sub Build_ADN_FR()
Dim Activity As Range, Matrix As Range, MStart As Range
Dim LR1 As Long, LR2 As Long, LR3 As Long, PNLS As Long
Dim RAX As Double, RI As Double, Disc As Double
Dim Question As Integer
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Retreated AX data").UsedRange.ClearContents
Sheets("Retreated Infoview data").UsedRange.ClearContents
Sheets("Dataloader").UsedRange.ClearContents
 
'Copier / coller les données AX de l'onglet d'origine dans l'onglet de retraitement
With Sheets("Original AX data")
    .AutoFilterMode = False
    .Range("A1:" & .Range("A1").SpecialCells(xlCellTypeLastCell).Address).Copy Sheets("Retreated AX data").Range("B1")
End With
 
'Indiquer le numéro de compte sur chaque ligne
With Sheets("Retreated AX data")
    .AutoFilterMode = False
    'Renommer les noms de champ
    .Range("A1:J1") = Array("Compte", "Date", "Activité", "N°document", "Libellé", "Devise", "Montant en devise", "Montant", "Cumul", "Résultat")
    LR1 = .Cells(.Rows.Count, 2).End(xlUp).Row
    With .Range("A2:A" & LR1)
        .Formula = "=IF(B2=""CPT"",C2,A1)"
        .Value = .Value
    End With
    .Range("F1:F" & LR1).AutoFilter Field:=1, Criteria1:="Devise", Criteria2:="=", Operator:=xlOr
    If .Range("F1:F" & LR1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        .Range("F2:F" & LR1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    .AutoFilterMode = False
 
    LR2 = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Each Activity In .Range("C2:C" & LR2)
        Activity.Value = Trim(Activity.Value)
    Next Activity
    'Calcul du résultat
    .Range("J2:J" & LR2).Formula = "=IF(OR(LEFT(TEXT(RC[-9],""000000""),1)=""6"",LEFT(TEXT(RC[-9],""000000""),1)=""7"",LEFT(TEXT(RC[-9],""000000""),3)=""186"",LEFT(TEXT(RC[-9],""000000""),3)=""187""),RC[-2],"""")"
    RAX = Format(WorksheetFunction.Sum(.Range("J2:J" & LR2)), "#,##.00")
    MsgBox "Source AX: Le résultat de la période est de " & RAX & " €", vbOKOnly, "Calcul du résultat"
End With
 
'Copier / coller les données Infoview de l'onglet d'origine dans l'onglet de retraitement
With Sheets("Original Infoview data")
    Set MStart = .UsedRange.Find("Account Number", LookIn:=xlValues)
    If Not MStart Is Nothing Then
        Set Matrix = .Range(MStart, MStart.End(xlToRight).End(xlDown))
        Matrix.Copy Sheets("Retreated Infoview data").Range("A1")
    End If
    Set MStart = Nothing
    Set Matrix = Nothing
End With
 
'Calcul du résultat Infoview
With Sheets("Retreated Infoview data")
    .AutoFilterMode = False
    LR3 = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("J2:J" & LR3).Formula = "=IF(OR(LEFT(TEXT(RC[-9],""000000""),1)=""6"",LEFT(TEXT(RC[-9],""000000""),1)=""7"",LEFT(TEXT(RC[-9],""000000""),3)=""186"",LEFT(TEXT(RC[-9],""000000""),3)=""187""),RC[-1],"""")"
    RI = Format(WorksheetFunction.Sum(.Range("J2:J" & LR3)), "#,##.00")
    MsgBox "Source Infoview: Le résultat de la période est de " & RI & " €", vbOKOnly, "Calcul du résultat"
    'Calcul de l'écart entre résultats AX & Infoview
    Disc = Format(Round(CDbl(RAX - RI), 2), "#,##0.00")
    Question = MsgBox("La différence entre le résultat d'AX et d'Infoview est de " & Disc & " est-ce correct ?", vbYesNo + vbQuestion, "Calcul de l'écart de résultat")
    If Question = vbNo Then
        MsgBox "Erreur dans l'intégration des fichiers, veuillez recommencer la procédure depuis le début", vbCritical, "Erreur"
    Else
        MsgBox "Continuer", vbOKOnly + vbInformation, "Compilation des données"
        .Range("A1:J" & LR3).AutoFilter Field:=10, Criteria1:="="
        If .Range("A1:A" & LR3).SpecialCells(xlCellTypeVisible).Count > 1 Then
            .Range("A2:A" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("B2")
            .Range("I2:I" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("E2")
            .Range("I2:I" & LR3).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("F2")
        End If
        .AutoFilterMode = False
 
        With Sheets("Dataloader")
            PNLS = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        End With
        'Copier PNL
        With Sheets("Retreated AX data")
            .Range("A1:J" & LR2).AutoFilter Field:=10, Criteria1:="<>"
            If .Range("A1:A" & LR2).SpecialCells(xlCellTypeVisible).Count > 1 Then
                .Range("A2:A" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("B" & PNLS)
                .Range("C2:C" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("D" & PNLS)
                .Range("H2:H" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("E" & PNLS & ":F" & PNLS)
                .Range("B2:B" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("G" & PNLS)
                .Range("E2:E" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("H" & PNLS)
                .Range("D2:D" & LR2).SpecialCells(xlCellTypeVisible).Copy Sheets("Dataloader").Range("I" & PNLS)
            End If
            .AutoFilterMode = False
        End With
    End If
End With
Application.Calculation = xlCalculationAutomatic
End Sub

**Runsh63** · 06/06/2011, 13h51

Bonjour mercatog,

Merci d'avoir pris le temps d'avoir regardé et modifié mon bout de code. J'ai toujours le même problème sur le copy / paste à la fin mais c'est pas grave, je vais le faire en deux lignes, je sais que ça marche.
Merci beaucoup pour tes modifications, elles m'ont permises de comprendre un peu mieux comment articuler mon code, je préfère ne pas les citer pour ne pas passer pour une chèvre.
Le coup du :

Code :

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

1
2
If .Range("F1:F" & LR1).SpecialCells(xlCellTypeVisible).Count > 1 Then
        .Range("F2:F" & LR1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

est super, c'est un bon test à faire et je l'utiliserai à l'avenir. Ceci dit, une petite question, qu'arrive t-il justement si la condition n'est pas remplie, et que il n'y a qu'une seule ligne ? Que va faire la macro, s'arrêter ?

Je remarque que le temps d'exécution de ton code est plus de 10 fois plus rapide que le mien, ceci je pense du au fait que tu as supprimé pas mal de mes boucles par des formules Excel. Ce sont celles que j'utilisais quand je faisais le travail à la main, mais j'avais cru comprendre que faire des boucles était plus "pro". Là encore je me suis trompé... mais je progresse,..., doucement mais je progresse.
Merci beaucoup !

Bien à toi,

Runsh

**mercatog** · 06/06/2011, 14h02

Si tu as aucune ligne visible (suite au filtre), tu auras une erreur ici

Code :

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

.Range("F2:F" & LR1).SpecialCells(xlCellTypeVisible)

Aucune correspondance.

Besoin d'aide sur un simple Paste

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager