Kopieer een hoeveelheid cellen naar een verzamel tabblad.

[gaggie]

Ik heb een VBA gevonden bij Ron de Bruin, om een range van cellen te kopieren naar een verzameltabblad.
Deze worden na de laatste regel op dat verzameltabblad geschreven.
Het werkt prima, maar is het mogelijk om de VBA zo aan te passen dat hetgeen gekopieerd wordt boven de eerste regel wordt ingevoegd op het verzameltabblad.

Hieronder de code:

Sub Copy_1_Value_Property()
    Dim SourceRange As Range, DestRange As Range
    Dim DestSheet As Worksheet, Lr As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'fill in the Source Sheet and range
    Set SourceRange = Sheets("Sheet1").Range("A1:K1")

    'Fill in the destination sheet and call the LastRow
    'function to find the last row
    Set DestSheet = Sheets("Sheet2")
    Lr = LastRow(DestSheet)

    'With the information from the LastRow function we can create a
    'destination cell
    Set DestRange = DestSheet.Range("A" & Lr + 1)

    'We make DestRange the same size as SourceRange and use the Value
    'property to give DestRange the same values
    With SourceRange
        Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
    End With
    DestRange.Value = SourceRange.Value

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Mvg.

Guido

 

[snb]

Waarom die onlogische aanpak ?

 

[gaggie]

Klinkt gek, maar ik wil dat de nieuwste bovenaan staan.

 

[Warme bakkertje]

Sub tst()
    With Sheets("Sheet2")
        .Rows(2).Insert xlDown
        .Range("A2").Resize(, 11) = Sheets("Sheet1").Range("A1").Resize(, 11).Value
    End With
End Sub

 

[gaggie]

Hoe past dit in de VBA code die ik gebruik?

Mvg.

Guido

 

[Warme bakkertje]

Dit past er niet in, het vervangt alles wat daarboven staat.
De code voegt op blad2 in regel 2 een nieuwe regel in, schuift alle gegevens 1 rij naar onder en plaatst dan de nieuwe gegevens op rij 2.

 

[gaggie]

Ik ga het uit proberen.

Vast bedankt.

 

[gaggie]

Beste Warm Bakkertje,

Hij kopieert wel, maar overschrijf de andere data.

Ik heb een range van A5:M20 nodig.
Kan het ook op de eerste regel beginnen in sheet Database, moet ik dan row(1) zetten?

Ik had de range aangepast zie onder maar die doet ook maar 1 regel.

Sub tst_E1R()
    With Sheets("Database")
        .Rows(1).Insert xlDown
        .Range("A1:M16").Resize(, 13) = Sheets("E1-Rekenen").Range("A5:M20").Resize(, 13).Value
    End With
End Sub

mvg

Guido

 

[Warme bakkertje]

Sub tst_E1R()
    With Sheets("Database")
        For i = 1 To 15
            .Rows(1).Insert xlDown
        Next
        .Range("A1").Resize(15, 13) = Sheets("E1-Rekenen").Range("A5:M20").Value
    End With
End Sub