fusion plusieurs feuille en une seule

Sub transfert()
    Dim f As Worksheet
    Sheets.Add before:=Sheets(1)
    
    For Each f In Worksheets
        If Not f.Index = 1 Then
            a = f.UsedRange
            Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2).Resize(UBound(a, 1), UBound(a, 2)) = a
        End If
    Next f

    a = Sheets(1).UsedRange
    For i = UBound(a) To 3 Step -1
        If a(i, 1) = "Div" Then Sheets(1).Rows(i + 1).EntireRow.Delete
    Next i
    Sheets(1).Rows("1:1").Delete
End Sub