Bonjour à tous,
Grace à ce magnifique forum j'ai trouvé des codes pour constituer cette macro (je remercie les auteurs). Mon problème se situe dans la boucle if then, juste après le else.
Pour résumer, je récupère des données de tous les fichiers xl d'un répertoire pour les compiler dans un autre fichier xl également dans ce répertoire (obligé de le mettre avec les autres !).
Dans la boucle de tous les fichiers, je cherche le code qui dit à VB de passer directement au fichier suivant lorsqu'il arrive au fichier qui porte le même nom que le fichier déjà ouvert.
Merci de votre aide.
Batiscaf.
Sub ARecup_donnees()
Dim recap As Worksheet
Dim txt, r2, r3 As String
Dim cel, r As Range
ChDir ActiveWorkbook.Path 'emplacement du fichier récap
Set recap = ActiveWorkbook.Sheets(1)
fichier = ActiveWorkbook.Name
'recap.Range("A4:L300").Clear
compteur = 4 'puisque ligne 1 à 3 = en-têtes
ChDir ActiveWorkbook.Path 'emplacement du fichier récap
nf = Dir("*.xls*") 'tous les fichiers Excel (dans le répertoire défini + haut)
Application.ScreenUpdating = False
Do While nf <> ""
If nf <> fichier Then
Workbooks.Open Filename:=nf
Workbooks(nf).Sheets(1).Range("C8").Copy Destination:=recap.Range("C" & compteur)
Workbooks(nf).Sheets(1).Range("C14").Copy Destination:=recap.Range("G" & compteur)
Workbooks(nf).Sheets(1).Range("C11").Copy Destination:=recap.Range("I" & compteur)
Workbooks(nf).Sheets(1).Range("C12").Copy Destination:=recap.Range("J" & compteur)
Workbooks(nf).Sheets(1).Range("C13").Copy Destination:=recap.Range("K" & compteur)
Workbooks(nf).Sheets(3).Range("C28").Copy
recap.Range("O" & compteur).PasteSpecial Paste:=xlPasteValues
Workbooks(nf).Sheets(3).Range("C27").Copy
recap.Range("P" & compteur).PasteSpecial Paste:=xlPasteValues
For Each r In Workbooks(nf).Sheets(1).Range("A1:A" & Range("A65536").End(xlUp).Row) '("a1:a10000")
txt = "*VAT applicable*"
If r.Value Like txt Then
r2 = "" & r.Address & ""
r3 = Range(r2).Offset(0, 5).Copy
End If
Next
recap.Range("T" & compteur).PasteSpecial Paste:=xlPasteValues
Workbooks(nf).Sheets(3).Range("C25").Copy
recap.Range("W" & compteur).PasteSpecial Paste:=xlPasteValues
compteur = compteur + 1 'incrémenter lignes dans récap
Workbooks(nf).Close False
nf = Dir
Else
'dire de passer au fichier suivant
compteur = compteur
End If
Loop
Application.ScreenUpdating = True
MsgBox ("Terminé.")
End Sub
Grace à ce magnifique forum j'ai trouvé des codes pour constituer cette macro (je remercie les auteurs). Mon problème se situe dans la boucle if then, juste après le else.
Pour résumer, je récupère des données de tous les fichiers xl d'un répertoire pour les compiler dans un autre fichier xl également dans ce répertoire (obligé de le mettre avec les autres !).
Dans la boucle de tous les fichiers, je cherche le code qui dit à VB de passer directement au fichier suivant lorsqu'il arrive au fichier qui porte le même nom que le fichier déjà ouvert.
Merci de votre aide.
Batiscaf.
Sub ARecup_donnees()
Dim recap As Worksheet
Dim txt, r2, r3 As String
Dim cel, r As Range
ChDir ActiveWorkbook.Path 'emplacement du fichier récap
Set recap = ActiveWorkbook.Sheets(1)
fichier = ActiveWorkbook.Name
'recap.Range("A4:L300").Clear
compteur = 4 'puisque ligne 1 à 3 = en-têtes
ChDir ActiveWorkbook.Path 'emplacement du fichier récap
nf = Dir("*.xls*") 'tous les fichiers Excel (dans le répertoire défini + haut)
Application.ScreenUpdating = False
Do While nf <> ""
If nf <> fichier Then
Workbooks.Open Filename:=nf
Workbooks(nf).Sheets(1).Range("C8").Copy Destination:=recap.Range("C" & compteur)
Workbooks(nf).Sheets(1).Range("C14").Copy Destination:=recap.Range("G" & compteur)
Workbooks(nf).Sheets(1).Range("C11").Copy Destination:=recap.Range("I" & compteur)
Workbooks(nf).Sheets(1).Range("C12").Copy Destination:=recap.Range("J" & compteur)
Workbooks(nf).Sheets(1).Range("C13").Copy Destination:=recap.Range("K" & compteur)
Workbooks(nf).Sheets(3).Range("C28").Copy
recap.Range("O" & compteur).PasteSpecial Paste:=xlPasteValues
Workbooks(nf).Sheets(3).Range("C27").Copy
recap.Range("P" & compteur).PasteSpecial Paste:=xlPasteValues
For Each r In Workbooks(nf).Sheets(1).Range("A1:A" & Range("A65536").End(xlUp).Row) '("a1:a10000")
txt = "*VAT applicable*"
If r.Value Like txt Then
r2 = "" & r.Address & ""
r3 = Range(r2).Offset(0, 5).Copy
End If
Next
recap.Range("T" & compteur).PasteSpecial Paste:=xlPasteValues
Workbooks(nf).Sheets(3).Range("C25").Copy
recap.Range("W" & compteur).PasteSpecial Paste:=xlPasteValues
compteur = compteur + 1 'incrémenter lignes dans récap
Workbooks(nf).Close False
nf = Dir
Else
'dire de passer au fichier suivant
compteur = compteur
End If
Loop
Application.ScreenUpdating = True
MsgBox ("Terminé.")
End Sub