VBA Excel - 從目錄中的所有文件中復制一個范圍並粘貼到一個工作簿中，在第一個空行上累積

Question

我使用了一個很好的代碼，它在這里：

復制文件夾中所有文件的范圍並粘貼到主工作簿中

我通過提供以下內容將粘貼數據從列更改為行：

 shTarget.Cells(1, lRow).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

代替：

 shTarget.Cells(1, lRow).PasteSpecial xlPasteValuesAndNumberFormats

並且工作正常，盡管該范圍內的所有內容都被大致復制到同一個地方。 我希望將新數據復制到先前復制的數據下方的第一個空行（來自目錄中的第一個工作簿）。

我試圖通過此處的示例修改我的代碼：

https://www.mrexcel.com/board/threads/vba-paste-new-data-after-last-row.951096/

https://www.exceldemy.com/excel-vba-copy-paste-values-next-empty-row/

在下一個空行中復制並粘貼一組范圍

通過提供偏移量如下：

  shTarget.Cells(1, lRow).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats

但它沒有按預期工作。 數據仍然多次復制到同一個地方。 最終，目錄中只有我最后一個工作簿中的數據。

我的完整代碼如下所示：

Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)
Const Bo As String = "A2:H100"
Dim lRow As Long
lRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1
 shSource.Range(Bo).Copy
 shTarget.Cells(1, lRow).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
 Application.CutCopyMode = xlCopy
 End Sub

如果我改變

    lRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1

到

    lRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1)

然后我有一個錯誤：應用程序定義或 object 定義的錯誤

有什么方法可以累積復制數據嗎？ 即無論提供的范圍如何，第一個工作簿中的數據 (A2:A100) 僅占用 A2:A10 范圍，並且連續將第二個工作簿中的數據復制到范圍 A11:A30 等等？

Answer 1

使用方法復制數據

快速修復：使用 End 屬性（不推薦）

Sub CopyDataQF(ByVal shSource As Worksheet, ByVal shTarget As Worksheet)
    Const Bo As String = "A2:H100"
    Dim FirstRow As Long
    FirstRow = shTarget.Cells(shTarget.Rows.Count, "A").End(xlUp).Row + 1
    shSource.Range(Bo).Copy
    shTarget.Cells(FirstRow, "A").PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
End Sub

改進：使用 Find 方法

Sub CopyData(ByVal shSource As Worksheet, ByVal shTarget As Worksheet)
    
    ' Define constants.
    Const SRC_RANGE As String = "A2:H100"
    Const TGT_FIRST_CELL As String = "A2"
    
    ' Reference the Source range.
    Dim srg As Range: Set srg = shSource.Range(SRC_RANGE)
    
    ' Reference the given first Target cell.
    If shTarget.FilterMode Then shTarget.ShowAllData
    Dim tfCell As Range: Set tfCell = shTarget.Range(TGT_FIRST_CELL)
    
    ' Reference the first available Target cell, the cell in the same column
    ' but in the row below the bottom-most non-empty row.
    With tfCell
        Dim tlCell As Range
        Set tlCell = .Resize(shTarget.Rows.Count - .Row + 1, _
            shTarget.Columns.Count - .Column + 1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If Not tlCell Is Nothing Then
            Set tfCell = shTarget.Cells(tlCell.Row + 1, tfCell.Column)
        End If
    End With
    
    ' Copy.
    srg.Copy
    tfCell.PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    
End Sub