Aide completer macro concaténation d'onglets

pledger

XLDnaute Junior
Bonjour le Forum =)

Je vous explique mon petit soucis :

Je voudrais concatené tous les onglets d'un seul classeur dans une nouvelle feuille , et executer cette macro dans plusieurs classeurs , voici mon code :
Code:
Sub test()
Dim Wb As Workbook, w As Worksheet
Application.ScreenUpdating = False
For Each Wb In Workbooks
    If Wb.Name Like "Analyse*" Then
    For Each w In Wb.Worksheets
        If Wb.Name <> ActiveWorkbook.Name Or w.Name <> ActiveSheet.Name Then _
    w.Range("1:" & w.[A65536].End(xlUp).Row).Copy ActiveSheet.[A65536].End(xlUp)(2)
  Next
  
  
    End If
Next Wb
End Sub

Le petit soucis c'est que cela concatene mes onglets dans l'onglet actif . Je souhaiterai que cela crée un nouvel onglet dans chauqe classeur et que cela concatene les onglets de chaque classeurs dans celui ci. Avez vous une idée de comment faire ?
 

job75

XLDnaute Barbatruc
Re : Aide completer macro concaténation d'onglets

Bonjour pledger,

Code:
Sub test1()
Dim Wb As Workbook, F As Worksheet, w As Worksheet
Application.ScreenUpdating = False
For Each Wb In Workbooks
  If Wb.Name Like "Analyse*" Then
    On Error Resume Next
    Set F = Wb.Sheets("Concaténation")
    If Err Then 'si la feuille n'existe pas
      Set F = Wb.Sheets.Add 'crée une nouvelle feuille
      F.Name = "Concaténation" 'renomme cette feuille
    End If
    For Each w In Wb.Worksheets
      If w.Name <> F.Name Then _
        w.Range("1:" & w.[A65536].End(xlUp).Row).Copy F.[A65536].End(xlUp)(2)
    Next
    If Application.CountA(F.[1:1]) = 0 Then F.[1:1].Delete 'si la ligne 1 est vide
  End If
Next
End Sub
Dans chaque classeur la nouvelle feuille créée est nommée Concaténation.

A+
 
Dernière édition:

Discussions similaires