loop through sheets in the workbook and copy specific range from each sheet to a summary sheet.

[InnaG]

Good morning,
I have a spreadsheet with 5 or more sheets and I am trying to create code that will loop through sheets and copy the same range from each sheet to the "Overall Summary" sheet. The range should be copied into the next blank row.

Here is the code I have so far, please help.

Thank you

Sub CopyRangeFromMultiSheets()
'
' CopyRangeFromMultiSheets Macro
'


Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range


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




    'loop through all worksheets and copy the data to the DestSh


    Set DestSh = Worksheet("Overall Summary")

    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name And sh.Name <> "Data Quality" And sh.Name <> "Confidence Level" And sh.Name <> "Standard Reporting Rules" And sh.Name <> "s*" Then


            'Find the last row with data on the DestSh
            Last = LastRow + 1


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


          Sheets("Overall Summary").Select



End If


Next ws


End Sub

 

[Fluff]

How about

Sub InnaG()
   Dim Ws As Worksheet, DestSh As Worksheet
  
   Set DestSh = Worksheets("Overall Summary")
   For Each Ws In Worksheets
      If Ws.Name <> DestSh.Name And Ws.Name <> "Data Quality" And Ws.Name <> "Confidence Level" And Ws.Name <> "Standard Reporting Rules" And Ws.Name <> "s*" Then
         Ws.Range("A5:G14").Copy DestSh.Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Ws
End Sub

 

[veyselemre]

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


    With Application
        .ScreenUpdating = False
        .EnableEvents = False


        Set DestSh = Sheets("Overall Summary")
        For Each sh In ActiveWorkbook.Worksheets
            Select Case sh.Name
            Case DestSh.Name, "Data Quality", "Confidence Level", "Standard Reporting Rules"
            Case Else
                'If sh.Name <> "s*" Then
                If Not sh.Name Like "s*" Then
                    Last = DestSh.Cells(Rows.Count, 1).End(3).Row + 1
                    sh.Range("A5:G14").Copy
                    Sheets("Overall Summary").Cells(Last, "A").PasteSpecial xlValues
                End If
            End Select
        Next sh


        .ScreenUpdating = True
        .EnableEvents = True
    End With


End Sub

 

[InnaG]

Thank you, but I keep getting an error msg for Set DestSh = Worksheet("Overall Summary")

 

[InnaG]

thank you!!!! it worked

 

[Fluff]

Thank you, but I keep getting an error msg for Set DestSh = Worksheet("Overall Summary")

Typo on my part it should be

Set DestSh = Worksheet[COLOR=#ff0000]s[/COLOR]("Overall Summary")

 

[InnaG]

Thanks

 

[Fluff]

You're welcome