将数据从一个工作簿复制到另一个缺少最后一行的工作簿时出错答案

【问题标题】：Error while copying Data from one workbook to another workbook with missing last row将数据从一个工作簿复制到另一个缺少最后一行的工作簿时出错
【发布时间】：2015-10-19 23:06:16
【问题描述】：

我写了一个代码，将数据从一个工作簿复制到另一个工作簿

Sub DataMerger()
    Dim MyFileName As String, MyPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    MyPath = "C:\FilesToMerge\"
    MyFileName = Dir(MyPath & "*.xl*")

    Do Until MyFileName = ""
        Workbooks.Open Filename:=MyPath & MyFileName

        Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Sheets

            If Len(ws.Name) > 1 Then
                Worksheets(1).Activate
                LastRow1 = ws.UsedRange.Row - 1 + ws.UsedRange.Rows.Count
                strAddress2 = "T2:T" & LastRow1
                wsName = ws.Name
                ws.Range(strAddress2).Value = wsName

                Dim DataBlock As Range, Dest As Range
                Dim LastRow As Long, LastCol As Long
                Dim SheetOne As Worksheet, SheetTwo As Worksheet
                Set SheetOne = ActiveWorkbook.Worksheets(wsName)
                Set SheetTwo = ThisWorkbook.Worksheets("Sheet1")
                ' Set Dest = SheetTwo.Cells(1, 1)
                Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp)
                MsgBox Dest, vbOKOnly, "Dest"

                With SheetOne
                    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    MsgBox LastRow, vbOKOnly, "LastRow"
                    LastCol = .Cells(1, .Columns.Count).End(xlToRight).Column
                    MsgBox LastCol, vbOKOnly, "LastColumn"
                    Set DataBlock = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
                End With

                With DataBlock
                    .AutoFilter Field:=1, Criteria1:="=*ON*"
                    .SpecialCells(xlCellTypeVisible).Copy Destination:=Dest
                End With

                With SheetOne
                    .AutoFilterMode = False
                    If .FilterMode = True Then .ShowAllData
                End With

            End If

            ActiveWorkbook.Close True

        Next

        wbName = ActiveSheet.Name
        ActiveWorkbook.Save
        MyFileName = Dir

    Loop
End Sub

此代码将进入文件夹“FilestoMerge”并打开工作簿并将工作表 (1) 设为活动工作表，然后将工作表的名称复制到 T 列。

之后，它会过滤列 A 上的值为 ON 的数据，并将数据复制到另一个工作簿。数据被完美复制，但我注意到它错过了数据的最后一行，例如，如果数据存在的最后一行是 65434，它只会将数据复制到第 65433 行。

我已经尝试了所有方法来找出问题所在，但没有运气。我相信这个说法

Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp)

是错误的主要原因，但不确定。

我相信数据可以完美地从SheetOne 复制到sheetTwo，但是当新数据来自另一个工作簿时，它会被覆盖。

【问题讨论】：

标签： vba excel

【解决方案1】：

Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp)

将 dest 设置为 A 列中包含数据的最后一个单元格。该行与转到工作表上的最后一个单元格然后按 ctrl + 向上箭头相同。完成后你需要下一行。

试试：

Set Dest = SheetTwo.Range("A" & Rows.Count).End(xlUp).offset(1)

这将转到 A 列中包含数据的最后一个单元格，然后向下移动一个。

【讨论】：