Wie o wie: Rijen kopieren naar een andere sheet

[Schreu48]

Hallo iedereen!

Ik wil de waarden van 2 stukken kolommen kopieren naar 2 kolommen in mn datasheet (Database Arrival Patterns).

De volgende code heb ik reeds aan een commandbutton 'Export' gehangen:

Dim paxnumbers As Range
    Dim groupsize As Range
    Dim Lr As Long
    Lr = LastRow(Sheets("Database Arrival Patterns")) + 1
    Set groupsize = Sheets("Arrival Patterns and queues").Range("D18:D420")
    With groupsize
        Set paxnumbers = Sheets("Database Arrival Patterns").Range("B" & Lr). _
        Resize(.Rows.Count, .Columns.Count)
    End With
    paxnumbers.Value = groupsize.Value

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row, _
                                                      
    On Error GoTo 0
End Function

Dit werkt perfect iedere keer als ik op export klik zoekt ie de laatste rij op in kolom D en worden wanneer ik een volgende keer op export klik de waardes eronder geplakt.

ECHTER, heb ik een 2e kolom waarvan ik de waardes ook naar die database wil kopieren, de code ziet er nu als volgt uit:

 Dim paxnumbers As Range
    Dim groupsize As Range
    Dim Lr As Long
    Lr = LastRow(Sheets("Database Arrival Patterns")) + 1
    Set groupsize = Sheets("Arrival Patterns and queues").Range("D18:D420")
    With groupsize
        Set paxnumbers = Sheets("Database Arrival Patterns").Range("B" & Lr). _
        Resize(.Rows.Count, .Columns.Count)
    End With
    paxnumbers.Value = groupsize.Value

    Dim arrivaltime1 As Range
    Dim arrivaltime2 As Range
   
    Lr = LastRow(Sheets("Database Arrival Patterns")) + 1
    Set arrivaltime2 = Sheets("Arrival Patterns and queues").Range("E18:E420")
    With arrivaltime2
        Set arrivaltime1 = Sheets("Database Arrival Patterns").Range("C" & Lr). _
        Resize(.Rows.Count, .Columns.Count)
    End With
    arrivaltime1.Value = arrivaltime2.Value

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row, _
                                                      
    On Error GoTo 0
End Function

En hier gaat het dus mis.... de 1e rij getallen (D18420) wordt mooi in kolom B geplaatst. De 2e rij getallen (E18:E420) zou in kolom C ernaast geplaatst moeten worden. Dit gebeurt ook, alleen worden ze gekopieerd VANAF de laatste rij waar de rij getallen in de kolom ernaast (kolom B) geëindigd is.

Hoe kan ik dit oplossen?

Alvast bedankt!

 

[Schreu48]

P.S De gebruikte code komt trouwens van de volgende site af:

http://www.exceltip.com/st/Copy_a_range_with_one_Area_to_a_Database_sheet_using_VBA_in_Microsoft_Excel/543.html

 

[HierEnNu]

Volgens mij gaat het hier fout:

[Set arrivaltime1 = Sheets("Database Arrival Patterns").Range("C" & Lr). _
/CODE]

Lr verwijst naar de laatste rij op blad Database arrival patterns
Als daar in kolom B reeds gegevens staan dan wordt via de code de laatste rij gezocht en worden de de gegevens in kolom C dus vanaf die rij geplakt.

Groeten,

M.

 

[Schreu48]

Okee dus je bedoelt dat de 'fout' zit in de definitie van de functie Lastrow? Geen idee hoe ik dat dan aan zou moeten passen. Ik heb de functie ook maar gevonden met handig zoeken op google. tips? thx alvast!

 

[Schreu48]

mss werkt een voorbeeldje erbij wat handiger. Zoals je ziet komen de gekopieerde rijen niet naast elkaar te staan in column B en C in de databases hoe los ik dit op? Volgens mij zoekt hij naar de volgende lege rij in de hele sheet en hij moet dus alleen naar de rijen zoeken in de betreffende column? Hoe pas ik dit aan in de functie of heeft iemand een betere code? Alvast thx!


en het gaat dan om dit stukje code:

[SIZE="1"]Dim groupnumberssource As Range
    Dim groupnumbersdest As Range
    Dim Lr As Long
    Lr = LastRow(Sheets("Database Arrival Patterns")) + 1
    Set groupnumberssource = Sheets("Arrival Patterns and queues").Range("D18:D420")
    With groupnumberssource
        Set groupnumbersdest = Sheets("Database Arrival Patterns").Range("B" & Lr). _
        Resize(.Rows.Count, .Columns.Count)
    End With
    groupnumbersdest.Value = groupnumberssource.Value

    Dim arrivaltimesource As Range
    Dim arrivaltimedest As Range
  
    Lr = LastRow(Sheets("Database Arrival Patterns")) + 1
    Set arrivaltimesource = Sheets("Arrival Patterns and queues").Range("E18:E420")
    With arrivaltimesource
        Set arrivaltimedest = Sheets("Database Arrival Patterns").Range("C" & Lr). _
        Resize(.Rows.Count, .Columns.Count)
    End With
    arrivaltimedest.Value = arrivaltimesource.Value[/SIZE]

Thx!

 

[Schreu48]

Heb de oplossing gevonden! Voor diegenen die ook ooit dit probleem tegen komen:

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 = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row

    '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

Deze code werkt zonder functie en zoekt de laatst gevulde CEL in een KOLOM ipv de laatste RIJ in een complete SHEET.

Veel plezier ermee!

Komt trouwens van deze site af:http://www.rondebruin.nl/copy1.htm