Bonjour, après avoir fouiller sur le moteur de recherche je suis tombé sur quelques pistes intéressantes mais jamais tout à fait satisfaisantes.
En effet mon problème, même si plusieurs sujets de discussions l'on partiellement résolu, reste le même.
Je vais essayer de vous expliquer correctement ma situation:
J'ai différents classeurs Excel (533 évolutifs) comportant parfois plusieurs onglets ( rassemblant des listes de matériels)
J'aimerais fusionner l'ensemble des classeurs excels dans un seul et même classeur récapitulatif ( je précise que chaque feuille à la même forme (5 colonnes) mais que la quantité de lignes diffère.)
Pour l'instant, j'arrive à faire ça avec cette macro
Sub regroupe()
Dim chemin As String ' classeur regroupé
Dim rep As String ' répertoire à traiter
Dim fic As String ' classeur regroupé
Dim ligne As Long ' ligne écriture
Dim nbc As Integer ' nombre de classeurs
Dim nbf As Integer ' nombre de feuilles
Dim nbl As Integer ' nombre de lignes
Dim c As Integer ' nombre de colonnes
Dim l As Long ' ligne lecture
Dim Wf As Worksheet ' feuille regroupement
Dim Wl As Worksheet ' feuille regroupée
rep = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error GoTo fin
Set Wf = ThisWorkbook.ActiveSheet ' variable feuille groupe
Wf.Cells.ClearContents
nbc = 0: nbf = 0 ' initialisation variables
ligne = 1
fic = Dir(rep & "*.xls") ' recherche fichiers
While fic <> ""
If fic <> ThisWorkbook.Name Then
chemin = rep & fic ' chemin fichiers
Workbooks.Open chemin, 0 ' ouverture
Set Wl = ActiveWorkbook.Sheets(1)
nbl = Wl.UsedRange.Rows.Count
c = Wl.UsedRange.Columns.Count
If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Wf.Cells(ligne, 1)
ligne = ligne + nbl - l + 1
nbf = nbf + 1
ActiveWorkbook.Close SaveChanges:=False ' Fermeture du classeur
nbc = nbc + 1
End If
fic = Dir
Wend
fin:
MsgBox nbc & " classeurs regroupés avec " & nbf & " feuilles et " & ligne & " lignes"
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Mon problème non résolu est le suivant, je voudrais que le nom du document soit rajouter devant chaque ligne de matériel rajouté sur mon classeur récapitulatif (afin que je puisse filtrer par nom ensuite)
Merci d'avance pour votre aide
ps: la macro dont je vous parle est la 1er que j'utilise, je n'avais auparavant jamais même entendu parlé de "macro", ça fait deux jours que je creuse et je me suis résolu à vous demander un peu de votre temps.
Merci
Edouard Magne
En effet mon problème, même si plusieurs sujets de discussions l'on partiellement résolu, reste le même.
Je vais essayer de vous expliquer correctement ma situation:
J'ai différents classeurs Excel (533 évolutifs) comportant parfois plusieurs onglets ( rassemblant des listes de matériels)
J'aimerais fusionner l'ensemble des classeurs excels dans un seul et même classeur récapitulatif ( je précise que chaque feuille à la même forme (5 colonnes) mais que la quantité de lignes diffère.)
Pour l'instant, j'arrive à faire ça avec cette macro
Sub regroupe()
Dim chemin As String ' classeur regroupé
Dim rep As String ' répertoire à traiter
Dim fic As String ' classeur regroupé
Dim ligne As Long ' ligne écriture
Dim nbc As Integer ' nombre de classeurs
Dim nbf As Integer ' nombre de feuilles
Dim nbl As Integer ' nombre de lignes
Dim c As Integer ' nombre de colonnes
Dim l As Long ' ligne lecture
Dim Wf As Worksheet ' feuille regroupement
Dim Wl As Worksheet ' feuille regroupée
rep = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error GoTo fin
Set Wf = ThisWorkbook.ActiveSheet ' variable feuille groupe
Wf.Cells.ClearContents
nbc = 0: nbf = 0 ' initialisation variables
ligne = 1
fic = Dir(rep & "*.xls") ' recherche fichiers
While fic <> ""
If fic <> ThisWorkbook.Name Then
chemin = rep & fic ' chemin fichiers
Workbooks.Open chemin, 0 ' ouverture
Set Wl = ActiveWorkbook.Sheets(1)
nbl = Wl.UsedRange.Rows.Count
c = Wl.UsedRange.Columns.Count
If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Wf.Cells(ligne, 1)
ligne = ligne + nbl - l + 1
nbf = nbf + 1
ActiveWorkbook.Close SaveChanges:=False ' Fermeture du classeur
nbc = nbc + 1
End If
fic = Dir
Wend
fin:
MsgBox nbc & " classeurs regroupés avec " & nbf & " feuilles et " & ligne & " lignes"
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Mon problème non résolu est le suivant, je voudrais que le nom du document soit rajouter devant chaque ligne de matériel rajouté sur mon classeur récapitulatif (afin que je puisse filtrer par nom ensuite)
Merci d'avance pour votre aide
ps: la macro dont je vous parle est la 1er que j'utilise, je n'avais auparavant jamais même entendu parlé de "macro", ça fait deux jours que je creuse et je me suis résolu à vous demander un peu de votre temps.
Merci
Edouard Magne