从特定行/单元格开始并连续粘贴到下一个空行/单元格的宏

Question

我正在开发一个宏，它将复制一列数据中的所有其他值并连续粘贴到新工作表中的新列。在我下面的代码中，For i = 4 To LastRowC Step 2 循环正在工作，因为它表明要粘贴的第一个空行位于正确的位置。

但是，对于For i = 4 To LastRowC Step 2 循环，宏发现行太低了，因为有另一个填充行将其丢弃，我需要指定它以开始在特定单元格的上方粘贴。但它仍然需要在 for 循环期间查找用于粘贴的空行。这可能吗？

Option Explicit
Sub copyRange()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim strExtension As String
    Dim LastRowC As Long

    Const strPath As String = "C:\Users\NGiuliano\Desktop\UPLOADS2\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource.Sheets("Sheet1")
            LastRowC = wkbSource.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
            For i = 4 To LastRowC Step 2
                wkbSource.Worksheets("Sheet1").Range("A" & i).Copy
                wkbDest.Worksheets("WIP").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Next i

            For j = 4 To LastRowC Step 2
                wkbSource.Worksheets("Sheet1").Range("B" & j).Copy
                wkbDest.Worksheets("WIP").Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Next j

            Application.CutCopyMode = False
        End With
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

将基于我在上一个问题中提供的代码：

Dim nextrow as Long 'Option 1; this dimension isn't appropriate for Option 2
nextrow = 2 'starting row for pasting, used for Option 1

For i = 4 to LastRowC Step 2
    'Use Cells(i,"B") or Range("B" & i)

    'Option 1, use a counter (declare "nextrow" as Long and define before the loop, e.g., 2)
    wkbDest.Worksheets("WIP").Cells(nextrow,16).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    nextrow = nextrow + 1

    'Option 2, find next cell each time using "end(xldown)" 
    set nextcell = wkbDest.Worksheets("WIP").Cells(2,16).End(xlDown).Offset(1)
    nextcell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Next i

您可以使用任一选项，其中nextrow 是行号，nextcell 是实际使用的下一个单元格。

---

在您的代码中，您尝试使用标准的 lastrow 语法 (.End(xlUp))，如果需要，这非常好...您熟悉该脚本的实际工作原理吗？ /p>

With Workbooks("Name").Sheets("Name")
    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Option 1
    set nextcell = .Cells(.Rows.Count, 1).End(xlUp) 'Option 2
End With

按顺序：

• 查找工作簿
• 查找工作表
• 找到单元格
  • 找到列
  • 找到的列中所有行的计数（即 1,048,576）
• 从最后计数的行转到 xlUp 到包含数据的下一个单元格

现在，您可以set 将其作为一个范围，也可以通过.row/.column 找到您想要的参数。在您的示例中，您都没有这样做，实际上您的 .pastespecial 行中有不适当的语法。

花一些时间阅读代码中每一行的功能，这可能有助于您前进！