RED
XLDnaute Nouveau
Bonjour,
J'ai une macro capable de copier la même colonne a de plusieurs fichier a et b et c .... Dans la même colonne a du fichier ou il y a la macro, je cherche à copier ces données à la suite sans supprimer les autres et sans ouvrir les fichiers a,b,c , le soucis que je rencontre c’est que les données son variable et ils n'ont pas le même répertoire.
Si vous avez une idée de la solution merci de me la transmettre
Sub importDonnees()
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
Application.ScreenUpdating = False
Set principal = ThisWorkbook
repertoire = ThisWorkbook.Path
ChDir repertoire
fichier = Dir("*.xls")
Do While fichier <> ""
If fichier <> principal.Name Then
Workbooks.Open fichier
On Error GoTo suivant
With Sheets("synth")
On Error GoTo 0
On Error Resume Next
.[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.[A:A].Insert Shift:=xlToRight
.Range("A1:A" & .[b65536].End(xlUp).Row) = Left(fichier, Len(fichier) - 4)
.UsedRange.EntireRow.Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
End With
ActiveWorkbook.Close False
End If
suivant:
If Err.Number = 9 Then MsgBox "Pas de feuille ""synth"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False
fichier = Dir
Loop
End Sub
J'ai une macro capable de copier la même colonne a de plusieurs fichier a et b et c .... Dans la même colonne a du fichier ou il y a la macro, je cherche à copier ces données à la suite sans supprimer les autres et sans ouvrir les fichiers a,b,c , le soucis que je rencontre c’est que les données son variable et ils n'ont pas le même répertoire.
Si vous avez une idée de la solution merci de me la transmettre
Sub importDonnees()
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
Application.ScreenUpdating = False
Set principal = ThisWorkbook
repertoire = ThisWorkbook.Path
ChDir repertoire
fichier = Dir("*.xls")
Do While fichier <> ""
If fichier <> principal.Name Then
Workbooks.Open fichier
On Error GoTo suivant
With Sheets("synth")
On Error GoTo 0
On Error Resume Next
.[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.[A:A].Insert Shift:=xlToRight
.Range("A1:A" & .[b65536].End(xlUp).Row) = Left(fichier, Len(fichier) - 4)
.UsedRange.EntireRow.Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
End With
ActiveWorkbook.Close False
End If
suivant:
If Err.Number = 9 Then MsgBox "Pas de feuille ""synth"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False
fichier = Dir
Loop
End Sub