Question

我正在尝试一次复制所有工作表，然后粘贴到新工作表中。这些文件来自多个第三方，因此工作表可能会有所不同。我在尝试确定最后一行Lrow和最后一列Lcol时遇到了问题，因为出现了错误Object doesn't support this property or method。我计划将此提交给我的工作，所以我们非常感谢任何有关防错或一般宏提示的帮助。

Sub ws_copy()
Dim Lrow As Long
Dim Lcol As Long
Dim Pasterow As Long
Dim WSCount As Integer
Dim i As Integer

'On Error Resume Next
    'Application.DisplayAlerts = False
        i = Application.InputBox(prompt:="Enter the place order of first tab to be copied.", Title:="Worksheet Consolidation", Type:=1)


    If IsEmpty(i) = True Then
        Exit Sub
    Else

    If IsNumeric(i) = False Then
        MsgBox "Enter a numeric value."
    Else

    If IsNumeric(i) = True Then
         Worksheets.Add(before:=Sheets(1)).Name = "Upload"


            WSCount = Worksheets.Count

        For i = i + 1 To WSCount


        Lrow = Worksheets(i).Find("*", After:=Cells(1, 1), _
                    LookIn:=xlFormulas, _
                    Lookat:=xlPart, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

        Lcol = Worksheets(i).Find("*", After:=Cells(1, 1), _
                    LookIn:=xlFormulas, _
                    Lookat:=xlPart, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row


    Pasterow = Lrow + 1

    Workbook.Worksheets(i).Range(Cells(1, 1), Cells(Lrow, Lcol)).Copy
    Workbook.Worksheets("Upload").Cells(Pasterow, 1).Paste



        Next i

    Else
    Exit Sub

    End If
    End If
    End If

'On Error GoTo 0
'Application.DisplayAlerts = False

End Sub

Answer 1

查找最后一行/列的常用方法是：

With Worksheets(i)

    Lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column

End With

HTH

Answer 2

基于以下评论：

由于收到的文件种类繁多，我不能假设任何一列或一行都有最后一段数据。

您应该查看使用工作表的UsedRange属性（MSDN）。随着更多数据输入到工作表中，UsedRange会扩展。

有些人会避免使用UsedRange，因为如果输入了一些数据，然后删除了UsedRange，则会包含这些“空”单元格。保存工作簿时，UsedRange将自行更新。但是，在您的情况下，听起来这不是一个相关的问题。

一个例子是：

Sub Test()

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rngSource As Range
    Dim rngTarget As Range

    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet2")
    Set rngSource = wsSource.UsedRange

    rngSource.Copy Destination:=wsTarget.Cells

End Sub

Answer 3

这是一种在工作表中查找上次使用的行和上次使用的列的方法。它避免了UsedRange的问题以及您不知道哪一行可能具有最后一列（以及哪一列可能具有最后一行）的问题。适应您的目的：

Option Explicit
Sub LastRowCol()

Dim LastRow As Long, LastCol As Long

With Worksheets("sheet1") 'or any sheet
    If Application.WorksheetFunction.CountA(.Cells) > 0 Then
        LastRow = .Cells.Find(what:="*", after:=[A1], _
                    LookIn:=xlFormulas, _
                    searchorder:=xlByRows, _
                    searchdirection:=xlPrevious).Row
        LastCol = .Cells.Find(what:="*", after:=[A1], _
                    LookIn:=xlFormulas, _
                    searchorder:=xlByColumns, _
                    searchdirection:=xlPrevious).Column
    Else
        LastRow = 1
        LastCol = 1
    End If
End With

Debug.Print LastRow, LastCol

End Sub

尽管基本技术已被长期使用，但Siddarth Rout不久前发布了一个添加COUNTA的版本来解释工作表可能为空的情况 - 这是一个有用的补充。

Answer 4

如果要将每张工作表上的数据合并到一个MasterSheet中，请运行以下脚本。

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "RDBMergeSheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "RDBMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("A1:G1")

            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            'Optional: This will copy the sheet name in the H column
            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

此外，请参阅下面的链接，了解其他一些选项，以稍微不同的方式执行此操作。

http://www.rondebruin.nl/win/s3/win002.htm

VBA：尝试将所有工作表合并到单个工作簿中的一个新工作表中

4 个答案: