Macro to pull dynamic range from multiple sheets to summary sheet

[Ams]

Hi All,

I need to pull dynamic range, which can vary from B55:F55 to B55:F65, to "summary" sheet.
I need to omit some sheets since these are my working sheets. I have worked out following program but mot working. Please help me out.

Option Explicit
Sub summary()
  Dim sht As Worksheet
  Dim TargetCell As range 'cell just below last used cell in column C on sheet "SUMMARY"
  Dim SourceRng As range 'range starting in C12 to last used cell in column C and including columns C to G
 
  With Application
  .ScreenUpdating = False
 
  For Each sht In ActiveWorkbook.Worksheets
 
  Select Case sht.Name
  Case "Home", "GanttChart", "ProjectStatus", "ProjectPipeline", "PostLaunchSupport", "Summary", "WorkingSheet", "ProductMatrix", "ProjectTracker", "Template"

  'Skip these sheets by doing nothing
  Case Else
  'can't get this part to work..
  With sht
  Set SourceRng = range("B55", range("B65536").End(xlUp).Offset(0, 4))
  End With
  Set TargetCell = ThisWorkbook.Sheets("Summary").Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
  SourceRng.Copy TargetCell
  End Select
  Next sht
 
  .CutCopyMode = False 'clear clipboard
  .ScreenUpdating = True
  End With
 
End Sub

 

[Luke M]

Welcome to the forum!
Careful with your With statements, specifically leaving the first one on Application Open. The actual error is because of this line:
range("B55", range("B65536").End(xlUp).Offset(0, 4))

You had invoked a with statement, but neither of the Ranges have a preceding period letting the VB know that they should trace back up to the With object.

Full corrected code.

Sub summary()
Dim sht As Worksheet
Dim TargetCell As Range 'cell just below last used cell in column C on sheet "SUMMARY"
Dim SourceRng As Range 'range starting in C12 to last used cell in column C and including columns C to G


Application.ScreenUpdating = False

For Each sht In ActiveWorkbook.Worksheets

    Select Case sht.Name
        Case "Home", "GanttChart", "ProjectStatus", "ProjectPipeline", "PostLaunchSupport", "Summary", "WorkingSheet", "ProductMatrix", "ProjectTracker", "Template"
            'Skip these sheets by doing nothing
        Case Else
            'can't get this part to work..
            With sht
                Set SourceRng = .Range("B55", .Range("B65536").End(xlUp).Offset(0, 4))
            End With
            With ThisWorkbook.Worksheets("Summary")
                Set TargetCell = .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0)
            End With
            SourceRng.Copy TargetCell
    End Select
Next sht

With Application
    .CutCopyMode = False 'clear clipboard
    .ScreenUpdating = True
End With

End Sub

 

[Ams]

Thanks for help..Its working now but...I guess my code has one thing missing..For blank row (55th) in input sheets I am getting 54th row pasted in summary sheet.
and how would I get sheets name on "D" column.

 

[Luke M]

this should fix both of the issues.

Sub summary()
Dim sht As Worksheet
Dim TargetCell As Range 'cell just below last used cell in column C on sheet "SUMMARY"
Dim SourceRng As Range 'range starting in C12 to last used cell in column C and including columns C to G
Dim lastRow As Long

Application.ScreenUpdating = False

For Each sht In ActiveWorkbook.Worksheets

    Select Case sht.Name
        Case "Home", "GanttChart", "ProjectStatus", "ProjectPipeline", "PostLaunchSupport", "Summary", "WorkingSheet", "ProductMatrix", "ProjectTracker", "Template"
            'Skip these sheets by doing nothing
       Case Else
            'can't get this part to work..
           With sht
                lastRow = .Range("B65536").End(xlUp).Row
                'In case of blank rows, don't go above row 55
                If lastRow < 55 Then lastRow = 55
                Set SourceRng = .Range("B55", .Cells(lastRow, "F"))
            End With
            With ThisWorkbook.Worksheets("Summary")
                Set TargetCell = .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0)
            End With
            SourceRng.Copy TargetCell
            'Put sheet name in col D
            TargetCell.Offset(, -1).Resize(SourceRng.Rows.Count).Value = sht.Name
    End Select
Next sht

With Application
    .CutCopyMode = False 'clear clipboard
   .ScreenUpdating = True
End With

End Sub