selectie onderaan invoegen

[wim1985]

Ik heb een invoerbestand bv boek1 sheet1 waar op de cellen R1 t/m V1 data wordt ingevuld. Deze wil ik dan via een macro toevoegen aan de verzamellijst bv boek2 sheet2 R t/m V en dan wel onderaan toevoegenaan de data die die al staat in de kolomen R t/m V
Hoe schrijf je dat in vba

gr Wim

 

[Ginger]

Probeer deze 'ns (ongetest!)

workbooks("book2").sheets("sheet2").range("R" & range("R65536").end(xlup).offset(1).row).resize(,5) = workbooks("book1").sheets("sheet1").range("R1:V1).value"

Groet, Leo

 

[wim1985]

Hoi Leo,
Ik heb de code getest en wat aangepast (namen) maar hij wil niet meet dan 2 regels maken en overschrijft dan 1 ervan. Hoe kan dit?

Workbooks("kleur.xls").Sheets("materiaal").Range("R" & Range("R65536").End(xlUp).Offset(1).Row).Resize(, 5) = Workbooks("urenregistratie.xls").Sheets("invoerenuren").Range("R1:X1").Value

gr Wim

 

[Ginger]

Wim1985, Bestandje graag!

Groet, Leo

 

[Wigi]

Als je iets gebruikt als

Range("R65536")...

(dus zonder verwijzing naar een bestand of tabblad) dan geldt impliciet het actieve bestand en het actieve tabblad. Wat waarschijnlijk niet kleur.xls en blad materiaal is.

 

[wim1985]

Leo, ik heb 2 bestandjes gemaakt om dit stukje te kunnen testen. De uiteindelijke bestanden zijn erg groot en hebben niets met dit probleem te maken

gr Wim

 

[Wigi]

Analoog probleem: http://www.worksheet.nl/forumexcel/showthread.php?t=58443

 

[Warme bakkertje]

Wim, probeer volgende eens. Beide bestanden moeten wel geopend zijn

Sub uren_invoeren_hand2()
Dim wsFrom As Worksheet, wsTo As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Set wsFrom = Workbooks("Urenregistratie.xls").Worksheets("invoerenuren")
    Set wsTo = Workbooks("kleur.xls").Worksheets("Materiaal")
        With wsFrom
            .[H13].Copy
            wsTo.Cells(Rows.Count, 24).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .[H14].Copy
            wsTo.Cells(Rows.Count, 22).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .[H15].Copy
            wsTo.Cells(Rows.Count, 19).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .[H16].Copy
            wsTo.Cells(Rows.Count, 20).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            .[H17].Copy
            wsTo.Cells(Rows.Count, 18).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End With
    [H12:H17].ClearContents
Windows("kleur.xls").Activate
    [Q1:X65536].Sort Key1:=[Q2], Key2:=[R2], Key3:=[S2], Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
Workbooks("kleur.xls").Close Savechanges:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Mvg

Rudi