VBA Excel -从目录中的所有文件复制一个范围,并粘贴到一个工作簿的第一个空行上

f87krz0w  于 2022-12-14  发布在  其他
关注(0)|答案(1)|浏览(208)

我使用了一个很好的代码,如下所示:
Copying a range from all files within a folder and pasting into master workbook
我通过提供以下内容将粘贴数据从列更改为行:

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/
Copy and Paste a set range in the 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)

那么我就会遇到一个错误:应用程序定义或对象定义错误
是否有任何方法可以累积复制数据?即,第一个工作簿中的数据(无论提供的范围是什么)(A2:A100)只占用范围A2:A10,然后将第二个工作簿中的数据复制到范围A11:A30,依此类推?

zvms9eto

zvms9eto1#

使用方法复制数据

快速修复:使用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

相关问题