[XL-2010] Copie d'une colone d'un classeur vers une colonne d'un autre classeur [Résolu]

[GuiBar18]

Bonjour à tous,

Je dois rassembler en un seul classeur de synthèse les premières colonnes contenue dans plusieurs classeur (j'ai X classeurs dans un répertoire, tous sur le même modèle, qui en colonne A et B contiennent les valeurs qui m’intéressent. Je dois récupérer les colonnes A et B de chacun de ces classeur pour les placer dans un classeur de synthèse, côte à côte (et non bout à bout).

Grâce à pas mal de recherche sur ce forum j'ai pas mal avancé dans mon code.

Code :

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
Sub Copie_Debits()
'==========================================
'= Procédure de sélection d'un répertoire =
'= Utilise le scripting object            =
'==========================================
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
   
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
With fd
    If .Show = -1 Then
        For Each vrtSelectedItem In .SelectedItems
            Range("CheminDebit") = vrtSelectedItem
        Next vrtSelectedItem
    End If
End With
Set fd = Nothing


'========================
'= Procédure principale =
'========================

'# Déclaration des variables de la procédure
Dim oFso        As Object
Dim oFile       As Object
Dim oDirectory  As Object
Dim wkbMain     As Workbook
Dim wkbPAT      As Workbook
Dim wks         As Worksheet
Dim Debits      As Worksheet
Dim MaxLg       As Long   'Mesure de la longueur des colonnes copiées
Dim i           As Long   'Compteur pour décalage des colonnes
Dim Col         As String 'Incrément sur les colonnes
   
'# Création des objets de scripting
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oDirectory = oFso.getfolder(Range("CheminDebit"))
   
'# Affectation de la variable wkbMain au classeur accueillant les données
Set wkbMain = ThisWorkbook
Set Debits = Worksheets("DEBITS")
   
'# On active la gestion d'erreur
'On Error GoTo GestionErreur
   
'# On vérifie qu'il y a bien des fichiers dans le répertoire
If Not (oDirectory.Files.Count > 0) Then
    MsgBox "Le répertoire sélectionné ne contient aucun fichier !", vbCritical + vbOKOnly, "Erreur répertoire"
    Exit Sub
End If
   
'# Effacement préalable de la plage de données
Debits.Range("A:Z").CurrentRegion.Clear
   
'# Désactivation de certains paramètres pour accélerer le traitement
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
   
'# Mise a 1 de la valeur du compteur et initialisation du calcul
i = 1
Col = Split(Columns(i).Address(ColumnAbsolute:=False), ":")(1)
   
'# On parcours tous les fichiers du répertoire
For Each oFile In oDirectory.Files
    '# Si le fichier est un fichier Excel on l'ouvre.
    If Right(oFile.Name, 4) = ".XLS" Then
        Workbooks.Open Range("CheminDebit") & "\" & oFile.Name, 0 '<- 0: ne pas mettre à jour les liens externes.
        Set wkbPAT = ActiveWorkbook
        '# On parcours les onglets du fichier.
        For Each wks In wkbPAT.Worksheets
            '"Mesure de la lognueur de la Colonne
            '#Pour ce faire il faut combler les vides
            wks.Cells(5, 1) = "XXX"
            MaxLg = wks.Range("A1").End(xlDown).Row
            'Nettoyage du comblement des vises
            wks.Cells(5, 1).ClearContents
            '# On copie les infos récupérées dans la feuile débits
            wks.Range(Cells(1, 1), Cells(MaxLg, 2)).Copy (Sheets("DEBITS").Range(Cells(1, i), Cells(MaxLg, i + 1)))
            i = i + 2
            Col = Split(Columns(i).Address(ColumnAbsolute:=False), ":")(1)
        Next
        End If
        '# On ferme le fichier après récupération
       wkbPAT.Close SaveChanges:=False
Next
   
GestionErreur:
'# On ferme les objets créés
Set oFso = Nothing
Set oDirectory = Nothing
Set wkbPAT = Nothing
Set wkbMain = Nothing

'# Rétablissement des paramètres Excel
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With
   
MsgBox "Les données des fichiers ont été importées avec succès."

End Sub

Seulement, voila, quand j’exécute ce code, j'obtiens l'erreur 9 : "l'indice n'appartient pas à la sélection" (pour la cause, j'ai désactivé la gestion d’erreurs). La ligne qui pose souci est en rouge dans le code précédent.

Une grande partie de mon problème vient du fait que je n'incrémente pas sur les lignes mais sur les colonnes. Je ne veux pas qu'il colle à la suite, mais à chaque fois sur la colonne d’à coté. Mais la, pour cete question d'indice, je sèche un peu.
A noter que j'ai essayé avec une version plus classique du genre

Code :

wks.Range("A:B").Copy (Sheets("DEBITS").Range(Col)))

La ou col était de type String et donnait la lettre correspondant à la colonne de copie (en fonction de l'incrément)

[GuiBar18]

En cherchant bien j'ai trouvé.
Je devais être fatigué ce matin, la syntaxe de copy était à revoir :

Code :

wks.Range("A:B").Copy (wkbMain.Worksheets("Debits").Cells(1, i))