VBA Insert Sheet Name in For Each Loop

Question

I have a single workbook with more than 50 sheets. Each sheet is exactly the same number of rows and columns (data for each month is a sheet). I am using a For Each loop to copy a range of cells from each worksheet and paste into a Summary sheet. Then I'm deleting blank rows. How can I add the sheet name in a separate column during the For Each Loop. I want to know where the data from one sheet starts and ends.

Sub CopyRangeToAnotherSheet()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
    If Not wks.Name = "Summary" Then
        wks.Range("C1:J100" & wks.Cells(Rows.Count, "C").End(xlUp).Row).Copy_
        Destination:=Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(0)        
    End If
  Next

  Application.CutCopyMode = False
End Sub

Sub DeleteEmptyRows()

    Application.ScreenUpdating = False
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True

End Sub

Data

Col A   B       C       D
Value1, Value2, Value3, Sheet Name Here
Value1, Value2, Value3, Sheet Name Here
Value1, Value2, Value3, Sheet Name Here

David Zemens David Zemens · Accepted Answer · 2015-10-01T17:41:56

Try something like this, and I have made some revisions to make the code a little more legible:

Sub CopyRangeToAnotherSheet()
Dim wks As Worksheet
Dim copyRange as Range
Dim destRange as Range


For Each wks In ThisWorkbook.Worksheets
    If Not wks.Name = "Summary" Then
        '## Get the range which will be copied:
        Set copyRange = wks.Range("C1:J100" & wks.Cells(Rows.Count, "C").End(xlUp).Row)
        '## Get the range where you will paste:
        Set destRange = Worksheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(0)
        '## Copy/Paste:
        copyRange.Copy destRange
        '## Fill in the source worksheet (copyRange.Parent) sheet name
        destRange.Offset(0,3).Resize(copyRange.Rows.Count).Value = wks.Name


    End If
 Next
    Application.CutCopyMode = False
End Sub

VBA Insert Sheet Name in For Each Loop

1 Answers