For Each does not loop through sheets (without error) - excel

Question

I need quick help to find my mistake.
The code below should loop through sheets and copy data to respective columns.
But it only copies from 1 sheet
I tried reseting varaiables but nothing helps..
I have similar macro where For each loop and the same If statement works with out problem.
Update:
It appears the problem is here no matter what kind of outer loop i write to jump to next row it does not jump, It just keeps overwriting cells..
For Each c In MyDataHeaders
i = Application.WorksheetFunction.Match(c.value, ColHeaders, 0) 'Finds the
matching column name Rng.Offset(, i - 1).value = Intersect(DataBlock.EntireRow,
c.EntireColumn).value 'Writes the values
Stop
Next c
Code below:
Sub CopyDataBlocks()
Dim sht As Worksheet
Dim SourceSheet As Worksheet 'The data to be copied is here
Dim TargetSheet As Worksheet 'The data will be copied here
Dim ColHeaders As Range 'Column headers on Target sheet
Dim MyDataHeaders As Range 'Column headers on Source sheet
Dim DataBlock As Range 'A single column of data
Dim c As Range 'a single cell
Dim Rng As Range 'The data will be copied here (="Place holder" for the first data cell)
Dim i As Integer
'Change the names to match your sheetnames:
'Set SourceSheet = Sheets("ws1")
Set TargetSheet = Sheets("Master")
With TargetSheet
Set ColHeaders = .Rows(1) '.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft) 'Or just .Range("A1:C1")
Set Rng = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) 'Shoots up from the bottom of the sheet untill it bumps into something and steps one down
End With
For Each SourceSheet In ThisWorkbook.Worksheets
If SourceSheet.name Like "Sheet*" Then
With SourceSheet
Set MyDataHeaders = Intersect(.Rows(1), .UsedRange)
For Each c In MyDataHeaders
If Application.WorksheetFunction.CountIf(ColHeaders, c.value) = 0 Then
MsgBox "Can't find a matching header name for " & c.value & vbNewLine & "Make sure the column names are the same and try again."
Exit Sub
End If
Next c
'There was a match for each colum name.
'Set the first datablock to be copied:
Set DataBlock = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)) 'A2:A & the last cell with something on it on column A
'Resizes the target Rng to match the size of the datablock:
Set Rng = Rng.Resize(DataBlock.Rows.Count, 1)
'Copies the data one column at a time:
For Each c In MyDataHeaders
i = Application.WorksheetFunction.Match(c.value, ColHeaders, 0) 'Finds the matching column name
Rng.Offset(, i - 1).value = Intersect(DataBlock.EntireRow, c.EntireColumn).value 'Writes the values
Next c
End With
Set MyDataHeaders = Nothing
End If
Next SourceSheet
End Sub
Thanks!