Macro cummul feuil excel
Résolu
INFO15
Messages postés
11
Statut
Membre
-
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention -
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention -
bonjour
je voulais faire un cummul de plusieurs feuils excel mais ça marche pas un message d'erreur s'affiche sachant que l'entête des fichiers sont identique
voilà la macro
Sub A3_Cumul_brut()
Dim eni(300)
Set wb = ThisWorkbook
Set wso = Sheets("brut")
nl = wso.Cells(Rows.Count, 1).End(xlUp).Row
f = Dir(wb.Path & "\*.xls*")
While f <> ""
If f <> wb.Name Then
Set wbi = Workbooks.Open(wb.Path & "\" & f)
Set wsi = Sheets("brut")
For i = 1 To 300
eni(i) = 0
For j = 1 To 300
If Trim(wsi.Cells(1, i)) = Trim(wso.Cells(1, j)) Then eni(i) = j: Exit For
Next j
Next i
dl = wsi.UsedRange.Rows.Count
For i = 2 To dl
nl = nl + 1
For j = 1 To 300
wso.Cells(nl, eni(j)) = wsi.Cells(i, j)
Next j
Next i
wbi.Close
End If
f = Dir()
Wend
'''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''
Cells.Select
ActiveWorkbook.Worksheets("brut").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("brut").Sort.SortFields.Add Key:=Range( _
"A2:A58930"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("brut").Sort
.SetRange Range("A1:FU58930")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "Opération effectuée"
End Sub
je voulais faire un cummul de plusieurs feuils excel mais ça marche pas un message d'erreur s'affiche sachant que l'entête des fichiers sont identique
voilà la macro
Sub A3_Cumul_brut()
Dim eni(300)
Set wb = ThisWorkbook
Set wso = Sheets("brut")
nl = wso.Cells(Rows.Count, 1).End(xlUp).Row
f = Dir(wb.Path & "\*.xls*")
While f <> ""
If f <> wb.Name Then
Set wbi = Workbooks.Open(wb.Path & "\" & f)
Set wsi = Sheets("brut")
For i = 1 To 300
eni(i) = 0
For j = 1 To 300
If Trim(wsi.Cells(1, i)) = Trim(wso.Cells(1, j)) Then eni(i) = j: Exit For
Next j
Next i
dl = wsi.UsedRange.Rows.Count
For i = 2 To dl
nl = nl + 1
For j = 1 To 300
wso.Cells(nl, eni(j)) = wsi.Cells(i, j)
Next j
Next i
wbi.Close
End If
f = Dir()
Wend
'''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''
Cells.Select
ActiveWorkbook.Worksheets("brut").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("brut").Sort.SortFields.Add Key:=Range( _
"A2:A58930"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("brut").Sort
.SetRange Range("A1:FU58930")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "Opération effectuée"
End Sub