Justme
Justme

Reputation: 85

summary from various (specific) worksheets to one worksheet

All I want to do, within the same workbook, is to copy the value from cell B2 in several SELECTED worksheets and paste into column D in another worksheet called "Summary". In addition, I would like to also copy and paste the corresponding worksheet name in Column C. These are the two codes I have so far, both failed, not sure how to fix them, not sure if there is a better way to do it. I am new in VBA. I am sure you will find silly mistakes, please forgive me. Both codes fail under "Run-time error '5' : Invalid procedure call or argument". Any help is highly appreciated.

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

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim DestSh As Worksheet

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

    Set wb = ThisWorkbook
    Set DestSh = wb.Sheets("Summary")

    ' Loop through worksheets that start with the name "20"
    ' This section I tested and it works

    For Each sh In ActiveWorkbook.Worksheets
        If LCase(Left(sh.Name, 2)) = "20" Then

            ' Specify the range to copy the data
            ' This portion has also been tested and it works

            sh.Range("B2").Copy

            ' Paste copied range into "Summary" worksheet in Column D
            ' This is the part that does not work I get:
            ' Run-time error '5' :  Invalid procedure call or argument

            With DestSh.Cells("D2:D")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            ' This statement will copy the sheet names in the C column.
            ' I have not been able to check this part since I am stock in the previous step
            DestSh.Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name

        End If

    Next

ExitTheSub:

    Application.Goto Worksheets("Summary").Cells(1)


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

Second Code:

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

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet

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


    ' Loop through worksheets that start with the name "20"
    ' This section I tested and it works

    For Each sh In ActiveWorkbook.Worksheets
        If LCase(Left(sh.Name, 2)) = "20" Then

            ' Specify the range to copy the data
            ' This portion has also been tested and it works

            sh.Range("B2").Copy

            ' Paste copied range into "Summary" worksheet in Column D
            ' This is the part that does not work I get:
            ' Run-time error '5' :  Invalid procedure call or argument

            Worksheets("Summary").Cells("D2:D").PasteSpecial (xlPasteValues)

            ' This statement will copy the sheet names in the C column.
            ' I have not been able to check this part works since I am stock in the previous step
            Worksheets("Summary").Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name



        End If

    Next

ExitTheSub:

    Application.Goto Worksheets("Summary").Cells(1)


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

Upvotes: 0

Views: 56

Answers (1)

Mrig
Mrig

Reputation: 11702

I've made changes to your First code:

    Sub CopyRangeFromMultiWorksheets()
        Dim sh As Worksheet
        Dim wb As Workbook
        Dim DestSh As Worksheet
        Dim LastRow As Long

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

        Set wb = ThisWorkbook
        Set DestSh = wb.Sheets("Summary")

        ' Loop through worksheets that start with the name "20"
        ' This section I tested and it works

        For Each sh In ActiveWorkbook.Worksheets
            If LCase(Left(sh.Name, 2)) = "20" Then

                ' Specify the range to copy the data
                ' This portion has also been tested and it works

                sh.Range("B2").Copy

                LastRow = DestSh.Cells(Rows.Count, "D").End(xlUp).Row + 1   'find the last row of column "D"

                ' Paste copied range into "Summary" worksheet in Column D
                ' This is the part that does not work I get:
                ' Run-time error '5' :  Invalid procedure call or argument

                'With DestSh.Cells("D2:D")      ----> this line is giving error
                With DestSh.Cells(LastRow, 4)  '----> 4 is for Column "D"
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With

                ' This statement will copy the sheet names in the C column.
                ' I have not been able to check this part since I am stock in the previous step

                LastRow = DestSh.Cells(Rows.Count, "C").End(xlUp).Row + 1   'find the last row of column "C"

                'DestSh.Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name    ----> this line is giving error
                DestSh.Cells(LastRow, 3).Value = sh.Name                   '----> 3 is for Column "C"

            End If
        Next
    ExitTheSub:
        Application.Goto Worksheets("Summary").Cells(1)
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub

Upvotes: 1

Related Questions