VBA is stopping before it is done - excel

Question

I have a problem...
I have two datasets in the same workbook on different sheets.
The first column in both datasets are identifiers. In Sheet1 I have my dataset, and want to fill it with data from Sheet2 (which is also containing data (rows+Columns) that I do not want to use.
I have a VBA that is working, BUT, it stops before it is done.
E.g. I have 1598 Rows in Sheet2, but it stops working already after 567 rows..
Sub Test()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("Sheet2")
Set Target = ActiveWorkbook.Worksheets("Sheet1")
j = 2
For Each c In Source.Range("A2", Source.Range("A" & Source.Cells(Source.Rows.Count, "A").End(xlUp).Row))
If c = Target.Cells(j, 1).Value Then
Source.Range("D" & c.Row & ":AS" & c.Row).Copy Target.Cells(j, 26)
j = j + 1
End If
Next c
MsgBox "Done"
End Sub
Can someone help me and see if there is something obviously wrong with the code? I have tried it on smaller datasets, and then it works perfect.
If more information needed or you have some other tips, please ask/tell :D
Thanks!

Answer 1

VBA Solution
Try the following, it usese the WorksheetFunction.Match method to properly match the values of column A no matter which order they are.
It loops through all rows in Target, and tries to find a matching row in Source. If a match was found it copies it into the Target.
Option Explicit
Public Sub Test()
Dim Source As Worksheet
Set Source = ThisWorkbook.Worksheets("Sheet2")
Dim Target As Worksheet
Set Target = ThisWorkbook.Worksheets("Sheet1")
Dim LastRowTarget As Long
LastRowTarget = Target.Cells(Target.Rows.Count, "A").End(xlUp).Row
Dim tRow As Long
For tRow = 2 To LastRowTarget
Dim sRowMatch As Double
sRowMatch = 0 'reset match row
On Error Resume Next 'ignore if next line throws error
sRowMatch = Application.WorksheetFunction.Match(Target.Cells(tRow, 1).Value, Source.Columns("A"), 0)
On Error GoTo 0 're-enable error reporting
If sRowMatch <> 0 Then 'if matching does not find anything it will be 0 so <>0 means something was found to copy
Source.Range("D" & sRowMatch & ":AS" & sRowMatch).Copy Target.Cells(tRow, 26)
End If
Next tRow
MsgBox "Done"
End Sub
Formula Solution
Note that there is no need for VBA and this could actually also solved with formulas only. Either the VLOOKUP formula or a combination of INDEX and MATCH formula.
So in Sheet1 cell Z2 write =INDEX(Sheet2!D:D,MATCH($A2,Sheet2!$A:$A, 0)) and pull it down and right.