Bonsoir.
Je ne comprend pas pourquoi la macro du bouton IMPORTER WMS ne recopie pas la ligne 1.
Le bouton va chercher dans un dossier tous les fichiers commençant par wms et ensuite il rassemble dans l'onglet WMS ces fichiers les un en desdous des autres. J'aurais qu'il copie la ligne 1 dans cet onglet.
Voilà la macro + fichier
Sub ButtonWMS()
Dim MonRepertoire As String, fso As Object, DerLig_feuille_traitée As Long, f As Object, Fichier_traité As String, k As Integer
Dim Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = Sheets("WMS")
Ws.Cells.Clear
Set fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\extractions reappro\"
For Each f In fso.GetFolder(MonRepertoire).Files ' on passe en revue tous les fichiers de ce dossiers
If f.Name Like "wms*" Then
Workbooks.Open MonRepertoire & f.Name
Fichier_traité = ActiveWorkbook.Name
For k = 1 To Sheets.Count ' on passe en revue chaque feuille du fichier traité
Sheets(k).Activate
DerLig_feuille_traitée = ActiveSheet.Range("A65536").End(xlUp).Row
If Range("A2") = "" Then
GoTo Etiquette
Else
Range("A2:IV" & DerLig_feuille_traitée).Copy Destination:=Workbooks("Gestion ruptures.xls").Sheets("WMS").Range("A" & Workbooks("Gestion ruptures.xls").Sheets("WMS").Range("A65536").End(xlUp).Row + 1)
End If
Etiquette:
Workbooks(Fichier_traité).Activate
Next 'prochaine feuille
Workbooks(Fichier_traité).Close savechanges:=False
End If
Next f ' prochain fichier
End Sub
Merci à vous
Je ne comprend pas pourquoi la macro du bouton IMPORTER WMS ne recopie pas la ligne 1.
Le bouton va chercher dans un dossier tous les fichiers commençant par wms et ensuite il rassemble dans l'onglet WMS ces fichiers les un en desdous des autres. J'aurais qu'il copie la ligne 1 dans cet onglet.
Voilà la macro + fichier
Sub ButtonWMS()
Dim MonRepertoire As String, fso As Object, DerLig_feuille_traitée As Long, f As Object, Fichier_traité As String, k As Integer
Dim Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = Sheets("WMS")
Ws.Cells.Clear
Set fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\extractions reappro\"
For Each f In fso.GetFolder(MonRepertoire).Files ' on passe en revue tous les fichiers de ce dossiers
If f.Name Like "wms*" Then
Workbooks.Open MonRepertoire & f.Name
Fichier_traité = ActiveWorkbook.Name
For k = 1 To Sheets.Count ' on passe en revue chaque feuille du fichier traité
Sheets(k).Activate
DerLig_feuille_traitée = ActiveSheet.Range("A65536").End(xlUp).Row
If Range("A2") = "" Then
GoTo Etiquette
Else
Range("A2:IV" & DerLig_feuille_traitée).Copy Destination:=Workbooks("Gestion ruptures.xls").Sheets("WMS").Range("A" & Workbooks("Gestion ruptures.xls").Sheets("WMS").Range("A65536").End(xlUp).Row + 1)
End If
Etiquette:
Workbooks(Fichier_traité).Activate
Next 'prochaine feuille
Workbooks(Fichier_traité).Close savechanges:=False
End If
Next f ' prochain fichier
End Sub
Merci à vous