Erreur code VBA

Bonjour à Tous

Merci de me corriger le code ci-dessous.

Sub générer()
Application.ScreenUpdating = False
effacer

For j = 1 To 5
 Sheets(j).Select
 derligne = Range("A100000").End(xlUp).Row
 For i = 8 To derligne
 Sheets(j).Select
 Rows(i).Select
 Selection.Copy

 Sheets("Synthèse").Select
 lr = Range("A100000").End(xlUp).Row + 1
 Cells(lr, 1).Select
 ActiveSheet.Paste
 Application.CutCopyMode = False

  Next i
Next j
End Sub

Bonjour,

Une adaptation

Option Explicit

Sub générer()
Dim DerLigneC As Long, DerLigneS As Long
Dim Sh As Worksheet
    Application.ScreenUpdating = False
    With Sheets("Synthèse")
        DerLigneC = .Range("A" & Rows.Count).End(xlUp).Row
        .Range(Rows(8), Rows(DerLigneC)).Clear
        For Each Sh In Worksheets
            If Sh.Name <> .Name Then
                DerLigneS = Sh.Range("A" & Rows.Count).End(xlUp).Row
                Sh.Rows(8).Resize(DerLigneS - 7).Copy .Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next Sh
    End With
    Application.CutCopyMode = False
End Sub

A+

Bonjour pour l'adaptation

mais lors de la génération il supprime la 1ère ligne du colonne!!

Bonjour et bonne année,

Une autre proposition avec l'utilisation de tableaux (Excel 2007+)

Cdlt.

Public Sub générer3()
Dim ws As Worksheet, lRow As Long

    Application.ScreenUpdating = False
    With Worksheets("Synthèse")
        lRow = 8
        If Not .ListObjects(1).DataBodyRange Is Nothing Then _
           .ListObjects(1).DataBodyRange.Delete
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> .Name Then
                ws.ListObjects(1).DataBodyRange.Copy
                .Cells(lRow, 1).PasteSpecial xlPasteValues
                lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If
        Next ws
    End With
    Application.CutCopyMode = False

End Sub

Public Sub effacer2()

    With Worksheets("Synthèse")
        If Not .ListObjects(1).DataBodyRange Is Nothing Then _
           .ListObjects(1).DataBodyRange.Delete
    End With

End Sub

mais lors de la génération il supprime la 1ère ligne

Effectivement, il faut écrire

        DerLigneC = Application.Max(.Range("A" & Rows.Count).End(xlUp).Row, 8)

A+

Merci à vous tous