Question

我有一张带有两个标签的表格：

标签1上的

我在列J，K中有一个连续的数据块，它们的行数不同，但总是从J1，K1开始。

在标签2 上，我只在A列中有数据，从A1开始。

我正在寻找能让我动态选择标签1中整个数据块的代码，不过可能有很多行。

然后粘贴该块，它从选项卡2中A列的第一个空单元格开始。

这是我迄今为止的尝试：

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

请注意，当您使用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 2

答案较短

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也需要转到A然后代码

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 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

动态范围的数据要粘贴到另一张纸上？

3 个答案: