Excel 当0时，VBA UsedRange

我试图把一些东西放在一个列范围内，复制该列减去2行标题，然后将其粘贴到最后一行下的Sheet2中。当从sheet1中的范围中没有可复制的内容时，问题就出现了。我在考虑使用计数的If语句，但我认为必须有更好的方法来实现这一点。这是我目前所做的，很抱歉有点乱

 Sub CopyUsedRanges()

 Dim lrow As Long
 Dim sh As Worksheet
 Dim rng As Range

 Set sh = Worksheets("Sheet1")
 On Error Resume Next

   'First
    lrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = sh.UsedRange.Range("A3:C" & lrow)
    Set rng = rng.Copy
    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    'Second
    Worksheets("Sheet1").Activate
    lrow = ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Row

    Set rng = sh.UsedRange.Range("E3:G" & lrow)
    Set rng = rng.Copy
    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    'Third
    Worksheets("Sheet1").Activate
    lrow = ActiveSheet.Cells(Rows.Count, "I").End(xlUp).Row

    Set rng = sh.UsedRange.Range("I3:K" & lrow).Offset(1, 0)
    Set rng = rng.Copy
    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    'Fourth
    Worksheets("Sheet1").Activate
    lrow = ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Row

    Set rng = sh.UsedRange.Range("M3:O" & lrow)
    Set rng = rng.Copy
    Worksheets("Sheet2").Activate
    Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues


End Sub

---

这应该可以满足您的需要：

Sub CopyUsedRanges()
    Dim lrow As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet

    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")

    'First
    sh1.Activate
    lrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row
    If lrow > 2 Then
        sh1.Range("A3:C" & lrow).Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If

    'Second
    lrow = sh1.Cells(Rows.Count, "E").End(xlUp).Row
    If lrow > 2 Then
        sh1.Range("E3:G" & lrow).Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If

    'Third
    lrow = sh1.Cells(Rows.Count, "I").End(xlUp).Row
    If lrow > 2 Then
        sh1.Range("I3:K" & lrow).Offset(1, 0).Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If

    'Fourth
    lrow = sh1.Cells(Rows.Count, "M").End(xlUp).Row
    If lrow > 2 Then
        sh1.Range("M3:O" & lrow).Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End If

End Sub

---

为什么要将UsedRange与设置范围一起使用？如果lrow>=3，则只需使用它，也不需要所有的激活、选择和复制等操作，您只需说worksheetsDestination.rangeA1:A10.value=worksheetsSource.rangeA1:A10.value我使用它是因为我正在将Sheet1上的设置范围复制到Sheet1中的设置范围中，而不是相同的范围。示例范围E:G-磁头2从粘贴到表2中A:C范围的表1开始，然后从表1中的I:K范围到上一页A:C范围中的下一行sheet2@Nathan_Sav谢谢你的小费！实际上，我试图使用IF>3，然后我的问题是goto，因为它是有限的，而且我有几个范围可以从中复制。@Nathan_Sav有没有办法设置目标，以便根据您的建议将其放置在a:C列中的下一行？我一直在玩它，但它似乎不喜欢。CellsRows.Count，1.EndxlUp.Offset1，0.value被添加到混音中