VBA將數據從一張紙復制到另一張紙（到空白單元格）

Question

我想將數據從工作表INV_LEDGERS復制到“ Ready to upload表”中，但是“ Ready to upload已經包含了一些數據，因此我想遍歷“ Ready to upload表”中的A列，直到找到空白單元格，然后粘貼來自INV_LEDGERS的數據。

    Sub CopyLedgers()

Dim ws As Worksheet, ws1 As Worksheet
Dim LastRow As Long
Set ws = Sheets("INV_LEDGERS")
Set ws1 = Sheets("Ready to upload")

LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

For i = 4 To LastRow
If ws.Range("A" & i) > "" And ws1.Range("A" & i + 1) = "" Then
    ws.Range("A" & i & ":AE" & i).Copy
    ws1.Range("A" & i + 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Else
    End If
Next

End Sub

它不再顯示錯誤消息，但現在它從該行復制了INV_LEDGERS中的數據，該表中的Ready to upload數據在此結束。 我的意思是，如果Ready to upload數據在第82行結束，則代碼將從82行的INV_LEDGERS獲取數據，因此基本上缺少81行。

你能告訴我嗎？

非常感謝！

Answer 1

幾件事...使用了With語句，而不是復制/粘貼，而是在制作ws1.Value = ws.Value：

Sub CopyLedgers()
    Dim ws As Worksheet, ws1 As Worksheet, LastRow As Long
    Set ws = Sheets("INV_LEDGERS")
    Set ws1 = Sheets("Ready to upload")
    With ws
        LastRow = .Cells( .Rows.Count, 1).End(xlUp).Row
        For i = 4 To LastRow
            If .Range("A" & i) > "" And ws1.Range("A" & i + 1) = "" Then
                ws1.Range("A" & i + 1 & ":AE" & i + 1).Value = .Range("A" & i & ":AE" & i).Value
            End If
        Next
    End With
End Sub

---

編輯

Sub CopyLedgers()
    Dim ws As Worksheet, ws1 As Worksheet, LastRow As Long
    Set ws = Sheets("INV_LEDGERS")
    Set ws1 = Sheets("Ready to upload")
    With ws
        LastRow = .Cells( .Rows.Count, 1).End(xlUp).Row
        For i = 4 To LastRow
            If IsEmpty(ws1.Range("A" & i + 1)) Then
                ws1.Range("A" & i + 1 & ":AE" & i + 1).Value = .Range("A" & i & ":AE" & i).Value
            End If
        Next
    End With
End Sub

Answer 2

鑒於braX的評論，這是我的代碼。 由於您始終從分類帳數據的第4行開始，因此您可以復制整個部分，然后將其粘貼到上載工作表的最后一行+ 1。

Sub CopyLedgers()

    Dim ws As Worksheet, ws1 As Worksheet
    Dim LastRow, LRow As Long
    Set ws = Sheets("INV_LEDGERS")
    Set ws1 = Sheets("Ready to upload")

    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    LRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row

    ws.Range("A4:AE" & LastRow).Copy
    ws1.Range("A" & LRow + 1).PasteSpecial xlPasteValues

    End Sub