0
votes

I have a sheet with two tabs:

on tab 1 I have a contiguous block of data in Columns J,K that varies in the number of rows but always starts from J1, K1.

On tab 2 I have a data in Column A only, starting from A1.

I am looking for the code that will enable me to dynamically select the entire block of data in tab 1, however many rows deep that may be.

then paste that block, it starting at the first empty cell in column A in tab 2.

This is my attempt thus far:

Sub put_there2()
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim LastRowNumber As Long
Dim LastCell As Range
Dim WS As Worksheet

Set r1 = Range("A2:A100") 'Paste Location

Set WS = Worksheets("Sheet1")
With WS                                                 ' sheet in which to measure range of data to be pasted
    Set LastCell = .Cells(.Rows.Count, 10).End(xlUp)
    LastRowNumber = LastCell.Row


End With

Set r2 = Range(Cells(2, 10), Cells(LastRowNumber, 11))       'region to be copied

For Each r3 In r1
    If r3.Value = "" Then
        r2.Copy r3
        Exit Sub
    End If
Next


End Sub

Your thoughts are appreciated,

Best regards

3

3 Answers

0
votes

Note that when you use the Range() object, you are implicitly referencing the ActiveSheet, which may not be the sheet you think it is. It's always best to explicitly call out the sheet you need to reference.

Try this:

Sub test()
    Application.ScreenUpdating = False

    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long

    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")

    ' get last row of J in Sheet1
    iLastRowS1 = s1.Cells(s1.Rows.Count, "J").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

    'copy into sheet2
    s1.Range("J1", s1.Cells(iLastRowS1, "J")).Copy iLastCellS2

    ' get last row of K and copy
    iLastRowS1 = s1.Cells(s1.Rows.Count, "K").End(xlUp).Row
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

    s1.Range("K1", s1.Cells(iLastRowS1, "K")).Copy iLastCellS2

    Application.ScreenUpdating = True
End Sub
0
votes

A shorter answer will be

Set ws = Sheets("Sheet1")
ws.Range(ws.Range("J1:K1"), ws.Range("J1:K1").End(xlDown)).Copy
Sheets("Sheet2").Range("A1").End(xlDown).Offset(1,0).Paste

Incase K also needs to go to A then code will be

Set ws = Sheets("Sheet1")

ws.Range(ws.Range("J1"), ws.Range("J1").End(xlDown)).Copy
Sheets("Sheet2").Range("A1").End(xlDown).Offset(1,0).Paste

ws.Range(ws.Range("K1"), ws.Range("K1").End(xlDown)).Copy
Sheets("Sheet2").Range("A1").End(xlDown).Offset(1,0).Paste
0
votes

this was the code i needed many thanks

Sub test()
    Application.ScreenUpdating = False

    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long

    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")

    ' get last row number of J in Sheet1
    iLastRowS1 = s1.Cells(s1.Rows.Count, "J").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

    'copy&paste into sheet2
    s1.Range("J1", s1.Cells(iLastRowS1, "K")).Copy iLastCellS2

    Application.ScreenUpdating = True
End Sub