Question

这是我的代码的片段：

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 25))

这个想法是在我的目录中打开多个工作簿，复制某个范围并将该范围粘贴到主文件中。

该代码似乎工作正常，除了最后几天。偏移功能似乎无法正常工作，这导致我在主文件中最后复制的行被新粘贴重写，而不是跳转到下面的下一个空行。

为清楚起见，完整代码：

Sub LTD()
    Dim MyFile As String
    Dim erow
    Dim Filepath As String

    Filepath = "C:\Map\" 
    MyFile = Dir(Filepath)
    Do While Len(MyFile) > 0
        If MyFile = "File.xlsm" Then
            Exit Sub
        End If

        Workbooks.Open (Filepath & MyFile)
        Range("B60:D60").Copy
        ActiveWorkbook.Close

        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 25))

        MyFile = Dir
    Loop
End Sub

Answer 1

尝试这样的事情：

Sub LTD()
    Dim wb As Workbook, shtDest As Worksheet
    Dim MyFile As String
    Dim erow
    Dim Filepath As String

    Filepath = "C:\Map\"
    MyFile = Dir(Filepath) '<< think about adding a filetype filter here eg Dir(Filepath & "*.xlsx")

    Set shtDest = ThisWorkbook.Sheets("Sheet1")'<< or the tab name where
                                               '   you want the data to go...

    Do While Len(MyFile) > 0
        If MyFile <> "File.xlsm" Then

            Set wb = Workbooks.Open(Filepath & MyFile)

            'Option1: copy-paste
            wb.Sheets("Results").Range("B60:Z60").Copy _
                shtDest.Cells(shtDest.Rows.Count, 1).End(xlUp).Offset(1, 0)

            'Option2: copy values only
            With wb.Sheets("Results").Range("B60:Z60")
                shtDest.Cells(shtDest.Rows.Count, 1).End(xlUp).Offset(1, 0). _
                     Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With

            wb.Close False

        End If

        MyFile = Dir
    Loop
End Sub

注意-使用End（xlUp）查找最后填充的行仅在第一列中的所有单元格都有值的情况下才是可靠的：如果您有任何空白，则此方法可能无法提供所需的值结果。

VBA：偏移不起作用，正在重写当前行

1 个答案: