S
Steph
Hello. I have the following code that loops through all sheets in a
workbook, and copies and pastes specific rows if the contents in column B of
the many sheets match the value in A1 of the consolidation sheet.
My question is this, As it copies and pastes a row from a data sheet into
the consolidation sheet, can it also put into column E the data sheet name
where that row came from? Thanks!
Sub CreateTimesheets()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range
Dim rw As Long
Dim ws As Worksheet
rw = ActiveSheet.Range("a65536").End(xlUp).Row + 1
For Each ws In Worksheets
With ws
If .Name <> "Summary" And .Name <> "Summary (2)" _
And .Name <> "Sup Summary" And .Name <> "Summary by DM" _
And .Name <> "Sheet4" Then
Set rng = ws.Range("B3:B" & ws.Range("B65536").End(xlUp).Row)
For Each cell In rng
If cell.Value = ActiveSheet.Range("A1") Then
cell.EntireRow.Copy Destination:=ActiveSheet _
.Cells(rw, 1)
rw = rw + 1
End If
Next
End If
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
workbook, and copies and pastes specific rows if the contents in column B of
the many sheets match the value in A1 of the consolidation sheet.
My question is this, As it copies and pastes a row from a data sheet into
the consolidation sheet, can it also put into column E the data sheet name
where that row came from? Thanks!
Sub CreateTimesheets()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng As Range
Dim rw As Long
Dim ws As Worksheet
rw = ActiveSheet.Range("a65536").End(xlUp).Row + 1
For Each ws In Worksheets
With ws
If .Name <> "Summary" And .Name <> "Summary (2)" _
And .Name <> "Sup Summary" And .Name <> "Summary by DM" _
And .Name <> "Sheet4" Then
Set rng = ws.Range("B3:B" & ws.Range("B65536").End(xlUp).Row)
For Each cell In rng
If cell.Value = ActiveSheet.Range("A1") Then
cell.EntireRow.Copy Destination:=ActiveSheet _
.Cells(rw, 1)
rw = rw + 1
End If
Next
End If
End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub