Bonjour le forum,
Je vous présente tout d'abord ce 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
| Sub E4_WIP()
Dim fso As Object 'Système de fichiers
Dim rep As Object 'Répertoire
Dim cfr As Object 'Collection de fichiers du répertoire
Dim fic As Object 'Fichier (élément de la collection cfr)
Dim wbk As Workbook 'Classeur
Dim res As Workbook 'Classeur resultat
Dim rng As Range 'Plage de cellules
Dim dst As Range 'Cellule de destination
Dim pth As String 'Chemin du répertoire
Dim etc As Boolean 'En tête copié
Const lig$ = "4" 'Adresse de la première ligne des tableaux à copier
Const col$ = "C" 'Adresse de la colonne à tester
' Définir le répertoire à lire
pth = ThisWorkbook.Path & \tmp
' Créer le fichier résultat
Set res = Workbooks.Add(xlWBATWorksheet)
Set dst = res.Worksheets(1).Range("C1")
' Lecture du répertoire
Set fso = CreateObject("Scripting.FileSystemObject")
Set rep = fso.GetFolder(pth)
Set cfr = rep.Files
' Contrôler chaque fichier du répertoire
For Each fic In cfr
' - Vérifier s'il s'agit d'un fichier Excel...
If StrComp(fso.GetExtensionName(fic.Name), "xls", vbTextCompare) = 0 Then
' ... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways)
' Définir les lignes à copier
For j = 1 To wbk.Sheets.Count
If wbk.Worksheets(j).Name Like "*WIP*" Then
With wbk.Worksheets(i)
.Range("C1").Cut .Range("E1")
For i = 15 To 1 Step -1
If Not .Cells(lig, i).Find("HYPERION") Or .Cells(lig, i).Find("Hyperion") Or .Cells(lig, i).Find("hyperion") Is Nothing Then
.Cells(lig, i).EntireColumn.Delete
End If
Next i
Set rng = .Rows(lig & ":" & .Cells(.Rows.Count, col).End(xlUp).Row)
End With
' Si l'en-tête est déjà copié ....
If etc Then
' ... réduire les lignes aux données sans en-tête
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
End If
' Copier les lignes entières
rng.Copy dst
' En-tête copié
etc = True
' Destination suivante
Set dst = dst.Offset(rng.Rows.Count)
End If
' Fermer le fichier sans le modifier
wbk.Close False
End If
Next fic
End Sub |
Quand j'essaie de lancer la macro, elle plante car il y a un end if sans bloc if (celui souligné et en gras), alors que j'ai compté il y a autant de If que de End If (ou alors je suis trop fatigué pour m'en rendre compte...). Quand je le supprime ça me pose problème au Next fic "Référence de variable de contrôle incorrecte dans Next" (donc logiquement il manque un end if...).
Bref je m'arrache les cheveux depuis tout à l'heure sans comprendre...
Le but de la macro : dans un répertoire, il y a plusieurs classeurs, chacun de ces classeurs a une seule feuille qui m'intéresse, et que je souhaite récupérer dans un nouveau classeur résultat, le tout assemblé sur une seule et même feuille. Par contre je retraite un peu les feuilles avant de copier les données pour supprimer des éléments inutiles.
Merci d'avance pour votre aide.
