I am trying to copy cells from several worksheets to a summary worksheet if their date (held in col. G) falls within a given range. I want the macro to loop through column g in each sheet and pull in the information where there is a match before moving on to the next worksheet to do the same. Currently my code presents a compile error: Invalid qualifier for the x value within rng...I an new to VBA and can't see what I have done wrong.
Sub Copy_ProjectSummaryData()
Dim i As Integer
Dim ws_num As Integer
Dim rng As Range, destRow As Long
Dim starting_ws As Worksheet
Dim shtDest As Worksheet
Dim c As Range
Dim startdate As Date
Dim enddate As Date
Set starting_ws = ThisWorkbook.Worksheets(1) 'remember which worksheet is
active in the beginning
ws_num = ThisWorkbook.Worksheets.Count
Set shtDest = Sheets("Summary")
destRow = 4 'start copying to this row
destRow2 = 4 'start copying to this row
destRow3 = 4 'start copying to this row
destRow4 = 4 'start copying to this row
startdate = CDate(InputBox("Begining Date"))
enddate = CDate(InputBox("End Date"))
'Clear contents from sheet before running new report
Range("A4").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
'Find and pull in Escalated Risks within the date range for the report
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
Set rng =
Application.Intersect(ThisWorkbook.Worksheets(i).Range("G16:G20"),
ThisWorkbook.Worksheets(i).UsedRange)
For Each c In rng.Cells
If c.Value >= startdate And c.Value <= enddate Then
'Starting 6 cells to the left of c (col A),
' copy an 8-cell wide block to the other sheet,
' pasting it in Col B on row destRow
c.Offset(0, -6).Resize(1, 8).Copy _
shtDest.Cells(destRow, 2)
destRow = destRow + 1
End If
Next
Next
'Find and paste Risk Project Name
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
Set rng = Application.Intersect(ThisWorkbook.Worksheets(i).Range("G16:G20"),
ThisWorkbook.Worksheets(i).UsedRange)
For Each c In rng.Cells
If c.Value >= startdate And c.Value <= enddate Then
' copy C3 to the other sheet,
' pasting it in Col A on row destRow
Range("C3").Copy _
shtDest.Cells(destRow2, 1)
destRow2 = destRow2 + 1
End If
Next
Next
'Find and pull in New Issues within the date range for the report
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
Set rng =
Application.Intersect(ThisWorkbook.Worksheets(i).Range("G22:G26"),
ThisWorkbook.Worksheets(i).UsedRange)
For Each c In rng.Cells
If c.Value >= startdate And c.Value <= enddate Then
'Starting 6 cells to the left of c (col A),
' copy an 8-cell wide block to the other sheet,
' pasting it in Col B on row destRow
c.Offset(0, -6).Resize(1, 8).Copy _
shtDest.Cells(destRow3, 11)
destRow3 = destRow3 + 1
End If
Next
Next
'Find and paste Issues Project Name
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
Set rng =
Application.Intersect(ThisWorkbook.Worksheets(i).Range("G22:G26"),
ThisWorkbook.Worksheets(i).UsedRange)
For Each c In rng.Cells
If c.Value >= startdate And c.Value <= enddate Then
' copy C3 to the other sheet,
' pasting it in Col A on row destRow
Range("C3").Copy _
shtDest.Cells(destRow4, 10)
destRow4 = destRow4 + 1
End If
Next
Next
starting_ws.Activate 'activate the worksheet that was originally active
Range("B4").Select
Selection.Copy
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("K4").Select
Selection.Copy
Range("J4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub