要粘貼到另一個工作表的數據的動態範圍？

Question

我有兩個標籤的片材：

標籤1

上我在列數據的連續塊J，K，在行的數目而變化，但總是從J1，K1開始。

對選項卡2我只有列A中的數據，從A1開始。

我正在尋找能讓我動態地選擇標籤1中整個數據塊的代碼，然而很多行可能都很深。

然後粘貼塊，它開始在A列的第一個空單元格中的標籤2.

這是我嘗試迄今：

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 

您的想法是讚賞，

此致敬意

Answer 1

較短的答案將是

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 

櫃面K還如需要去那麼代碼將是

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 

Answer 2

請注意，當您使用Range（）對象時，您隱式引用ActiveSheet，它可能不是您認爲它的工作表。最好明確地調出你需要參考的工作表。

試試這個：

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 

Answer 3

這是我的代碼需要很多謝謝

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