Eerste 3 rijen niet mee kopiëren

[rukko]

Ik probeer de eerste 3 rijen niet mee te kopiëren uit alle sheets naar een bepaalde sheet.
Ik heb al meerdere dingen geprobeerd en gezocht op google maar kom er niet uit.

De code delete inhoud van sheet data. waarnaar hij alle sheets doorloopt met uitzondering "SEARCH, DATA, ZOEKEN".

Uit de overige kopieert hij alle info naar "DATA'. Nou zou hij alles moeten kopiëren behalve de eerste 3 rijen van de sheet.
Wat moet ik aan onderstaande

'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
            
            Const SEARCH = "Search"
            Const DATA = "Data"
            Const ZOEKEN = "zoeken"
'
'
'
'
'   Run macro: "WSdata"
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
Option Explicit
Sub WSAdata()
    Dim aSheet, aCell, ws, lr
    Dim fr As Long
    If ActiveSheet.Name = DATA Then Sheets(SEARCH).Activate ' un activate DATA ws as it is going to be deleted
    Set aSheet = ActiveSheet                                ' save for end
    Set aCell = ActiveCell                                  ' use these to restore to orginal position
    SetAppParams False                                      ' set application parameters
    If WSExists(DATA) Then Sheets(DATA).Cells.Clear         ' get rid of existing DATA worksheet

    For Each ws In ThisWorkbook.Sheets                      ' cycle through worksheets
        Select Case ws.Name
            Case SEARCH, DATA, ZOEKEN                       ' ignore these worksheets
            Case Else
                With Sheets(DATA)
                    lr = .UsedRange.Rows.Count + 1          ' get last row
                    If lr <= 2 Then lr = 1                  ' compensate for first row empty
                    ws.UsedRange.Copy                       ' copy ws usedrange
                    .Range("A" & lr).PasteSpecial xlAll     ' Paste Special to DATA
                End With
        End Select

    Next ws
    aSheet.Activate                                         ' reset active sheet
    aCell.Activate                                          ' and cell
    SetAppParams True                                       ' reset applicaiton params
    Sheets(DATA).Columns("A:B").Copy Destination:=Sheets(DATA).Range("J1")
End Sub

'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
Function WSExists(sName) As Boolean                         ' Returns a true or false depending on the
    Dim sDummy
    WSExists = False                                        ' existance of the worksheet named sName
    On Local Error Resume Next
    sDummy = Sheets(sName).Name
    If Err <> 0 Then Exit Function
    WSExists = True
End Function
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
Sub SetAppParams(bval As Boolean)                           ' sets the applicaiton stuff to true or false (bval)
    With Application
        .DisplayAlerts = bval
        .EnableEvents = bval
        .ScreenUpdating = bval
        .CutCopyMode = False
    End With
End Sub

 

[RvanGalenLast]

Ik heb een stukje van de code gewijzigd. Zie hieronder. Daarnaast heb de schuin gedrukte regel toegevoegd. De 3 constanten heb ik toegevoegd aan het begin van de code.

For Each ws In ThisWorkbook.Sheets
        Select Case ws.Name
            Case SEARCH, DATA, ZOEKEN
            Case Else
                With Sheets(DATA)
                    ws.UsedRange.Offset(3).Resize(ws.UsedRange.Rows.Count - 3).Copy _
                        Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(1)
                End With
        End Select
    Next ws
    [I]Sheets(DATA).Rows(1).EntireRow.Delete[/I]

 

[rukko]

Top dat is het helemaal.

Bedankt