Bonjour
J'ai plusieurs fichiers excel dans un même dossier , chaque fichier a plusieurs onglets
la structure des fichiers est identique et je souhaite compiler toutes les données dans un nouveau fichier avec un seul onglet avec les données à la suite
mon code ci dessous fonctionne uniquement pour les données du premier onglet
et pas les autres de plus il y a un bug il me copie 300 fois le premier enregistrement avant de passer au second
fichier source
Lien CJoint.com 0Jot7pxe5rK
je souhaite par chaque onglet de chaque fichier
collecter les données de la cellule A21 à G21
si quelqu’un pouvait m'aider à debuger merci d'avance
Sub ConvertirFichiersEnFeuilles()
Dim VarListeFichiers As Variant, VarFichier As Variant, WkClasseur As Workbook, WkFinal As Workbook, WsFeuille As Worksheet
VarListeFichiers = Application.GetOpenFilename(filefilter:="Classeurs eXceL,*.xls", Title:="Choisissez les Classeurs à récupérer", MultiSelect:=True)
If VarType(VarListeFichiers) = vbBoolean Then MsgBox "Abandon !": Exit Sub 'pour identifier le bouton annuler
Set WkFinal = Workbooks.Add 'générer le classeur final
For Ctr = 1 To UBound(VarListeFichiers)
Set WkClasseur = Workbooks.Open(Filename:=VarListeFichiers(Ctr))
Set WsFeuille = WkClasseur.Worksheets(1)
WsFeuille.Move before:=WkFinal.Worksheets(1)
WkClasseur.Close savechanges:=False
Next
Consolidationpourimportation
Exit Sub
End Sub
Sub Consolidationpourimportation()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
'--Suppression des messages d'alerte
Application.DisplayAlerts = False
'--Suppression des feuilles inutiles suite à l'importation
'--Copié/collé des données sur la Feuil1
For Ctr = 1 To Sheets.Count - 1
Sheets("feuil1").Activate
Col = "f" ' colonne données non vides à tester'
NumLig = 22 'alors là ca doit etre le N° de la 1er ligne de données en comptant la ligne 1 = 0 .... ? '
With Sheets(Ctr) ' feuille source'
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 3 To NbrLig 'n° de la 1ere ligne de données'
If .Cells(Lig, Col).Value <> "" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("feuil1").Cells(NumLig, 1).Insert Shift:=xlDown
'ici pour insérer ou .Paste pour coller'
End If
Next
End With
Next Ctr
End Sub
J'ai plusieurs fichiers excel dans un même dossier , chaque fichier a plusieurs onglets
la structure des fichiers est identique et je souhaite compiler toutes les données dans un nouveau fichier avec un seul onglet avec les données à la suite
mon code ci dessous fonctionne uniquement pour les données du premier onglet
et pas les autres de plus il y a un bug il me copie 300 fois le premier enregistrement avant de passer au second
fichier source
Lien CJoint.com 0Jot7pxe5rK
je souhaite par chaque onglet de chaque fichier
collecter les données de la cellule A21 à G21
si quelqu’un pouvait m'aider à debuger merci d'avance
Sub ConvertirFichiersEnFeuilles()
Dim VarListeFichiers As Variant, VarFichier As Variant, WkClasseur As Workbook, WkFinal As Workbook, WsFeuille As Worksheet
VarListeFichiers = Application.GetOpenFilename(filefilter:="Classeurs eXceL,*.xls", Title:="Choisissez les Classeurs à récupérer", MultiSelect:=True)
If VarType(VarListeFichiers) = vbBoolean Then MsgBox "Abandon !": Exit Sub 'pour identifier le bouton annuler
Set WkFinal = Workbooks.Add 'générer le classeur final
For Ctr = 1 To UBound(VarListeFichiers)
Set WkClasseur = Workbooks.Open(Filename:=VarListeFichiers(Ctr))
Set WsFeuille = WkClasseur.Worksheets(1)
WsFeuille.Move before:=WkFinal.Worksheets(1)
WkClasseur.Close savechanges:=False
Next
Consolidationpourimportation
Exit Sub
End Sub
Sub Consolidationpourimportation()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
'--Suppression des messages d'alerte
Application.DisplayAlerts = False
'--Suppression des feuilles inutiles suite à l'importation
'--Copié/collé des données sur la Feuil1
For Ctr = 1 To Sheets.Count - 1
Sheets("feuil1").Activate
Col = "f" ' colonne données non vides à tester'
NumLig = 22 'alors là ca doit etre le N° de la 1er ligne de données en comptant la ligne 1 = 0 .... ? '
With Sheets(Ctr) ' feuille source'
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 3 To NbrLig 'n° de la 1ere ligne de données'
If .Cells(Lig, Col).Value <> "" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("feuil1").Cells(NumLig, 1).Insert Shift:=xlDown
'ici pour insérer ou .Paste pour coller'
End If
Next
End With
Next Ctr
End Sub
