For Each Issues

[Th3Hovster]

Hello,

I am having a few issues with a for each macro I am working on. I am trying to compile information from forms in multiple worksheets into one list.

The information I need is in the same cells on all the forms and I have recorded the macro I need from one of the sheets and I am trying to apply that for all sheets in the workbook. My master is called HIT List and the way it sits now, it just pulls from HIT List instead of the other tabs and I'm also not sure if my paste in next empty cell portion is correct either.

Here is a portion of what I have so far, the rest of the code repeats this with just the cells changing:

Sub HITListCompile()
'
' HITListCompile Macro
'

For Each ws In ThisWorbook.Worksheets​

If ws.Name <> "HIT List" Then​

Range("C2").Select​

Application.CutCopyMode = False
Selection.Copy
Sheets("HIT List").Select
Range("A3").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("HIT List").Select
Range("B3").End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False​

Thanks in advance for taking a look

 

[Joe4]

The issue is that looping through the worksheets like that does not actually select/activate them.
So, you either need to activate each one in your loop with a line under your "For each..." line like this:

ws.Activate

or you need to use worksheet references in your range references.
I did that, and rather than use Copy/Paste, I just set the value equal to one another.
And there is an issue with how you are trying to find the first available rows in column A and B.
Try this:

Sub HITListCompile()
'
' HITListCompile Macro

    Dim ms As Worksheet
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    
    Set ms = Sheets("HIT List")

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "HIT List" Then
            ms.Cells(Rows.Count, "A").End(xlUp).Offset(1) = ws.Range("C2")
            ms.Cells(Rows.Count, "B").End(xlUp).Offset(1) = ws.Range("C3")
        End If
    Next ws

    Application.ScreenUpdating = True
    
End Sub

 

[Th3Hovster]

That's great! Thank you! Worked great.

 

[Joe4]

You are welcome!