1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
| 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.DisplayAlerts = False
Set Wf = ThisWorkbook.ActiveSheet ' variable feuille groupe
Wf.Cells.ClearContents
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
i = 2
Set Wl = Workbooks(fic).Sheets(i) ' choix de la feuille
nbl = Workbooks("global process de fabrication").Sheets("Codes articles concernés").UsedRange.Rows.Count
c = Workbooks("global process de fabrication").Sheets("Codes articles concernés").UsedRange.Columns.Count
Sheets("Codes articles concernés").Select
If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Workbooks("global process de fabrication").Sheets("Codes articles concernés").Cells(ligne, 1)
ligne = ligne + nbl - l + 1
nbf = nbf + 1
i = 3
ligne = 1
Set Wl = Workbooks(fic).Sheets(i) ' choix de la feuille
nbl = Workbooks("global process de fabrication").Sheets("Nomenclatures AC").UsedRange.Rows.Count
c = Workbooks("global process de fabrication").Sheets("Nomenclatures AC").UsedRange.Columns.Count
Sheets("Nomenclatures AC").Select
If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
ligne = ligne + nbl - l + 1
Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Workbooks("global process de fabrication").Sheets("Nomenclatures AC").Cells(ligne, 1)
nbf = nbf + 1
i = 4
ligne = 1
Set Wl = Workbooks(fic).Sheets(i) ' choix de la feuille
nbl = Workbooks("global process de fabrication").Sheets("Processus de fabrication").UsedRange.Rows.Count
c = Workbooks("global process de fabrication").Sheets("Processus de fabrication").UsedRange.Columns.Count
Sheets("Processus de fabrication").Select
If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
ligne = ligne + nbl - l + 1
Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Workbooks("global process de fabrication").Sheets("Processus de fabrication").Cells(ligne, 1)
nbf = nbf + 1
i = 5
ligne = 1
Set Wl = Workbooks(fic).Sheets(i) ' choix de la feuille
nbl = Workbooks("global process de fabrication").Sheets("Parc TF").UsedRange.Rows.Count
c = Workbooks("global process de fabrication").Sheets("Parc TF").UsedRange.Columns.Count
Sheets("Processus de fabrication").Select
If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
ligne = ligne + nbl - l + 1
Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Workbooks("global process de fabrication").Sheets("Parc TF").Cells(ligne, 1)
nbf = nbf + 1
ActiveWorkbook.Close SaveChanges:=False ' Fermeture du classeur
End If
fic = Dir
nbc = nbc + 1
Wend
fin:
MsgBox nbc & " classeurs regroupés avec " & nbf & " feuilles et " & ligne & " lignes"
End Sub |
Partager