Hi all,
I need to copy some rows with a specific Value in a Column from sheet1 called "Germany" to Sheet2 called "GIZ".
Example:
Sheet1 "Germany"
Iteam Reference Location
A 1 Germany
B 1 France
C 1 UK
D 2 Italy
E 3 USA
F 3 China

The thing is I don't know the order in Column "Reference" all I know is that they are grouped, but maybe 3 come before 1 or 2 etc..
And I need to keep that order too.

Now I want to copy all Rows with the Reference Nbr 1 and 3 to Sheet2 "GIZ" if possible sorted and grouped like in sheet1

I did a small macro, but i discovered that he missed some rows, and as Sheet1 has more than 3000 rows is difficult to check if he did everything or not.

OH before i forgot I want that he skip the reference and continue with the next one if the reference value is not there in sheet1


Here is my Macro as you see I have here 7 Value as reference.

Sub MyMacro()
Dim i As Long, iMatches As Long
'GIZ
Dim aBerlin() As String: aBerlin = Split("2323209", ",")
Dim aFrankfurt() As String: aFrankfurt = Split("2320979", ",")
Dim aMunich() As String: aMunich = Split("2321657", ",")
Dim aMARS() As String: aMARS = Split("2322974", ",")
Dim aEschborn() As String: aEschborn = Split("2326361", ",")
Dim aCologne() As String: aCologne = Split("2327129", ",")
Dim aCologne2() As String: aCologne2 = Split("2327129", ",")

' Want that the macro copy in Sheet "GIZ" begining from Row 16
iMatches = 15
For Each cell In Sheets("Germany").Range("M:M")
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aBerlin)
            If InStr(1, cell.Value, aBerlin(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
            End If
        Next
    End If
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aFrankfurt)
            If InStr(1, cell.Value, aFrankfurt(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
            End If
        Next
    End If
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aMunich)
            If InStr(1, cell.Value, aMunich(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
            End If
        Next
    End If
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aMARS)
            If InStr(1, cell.Value, aMARS(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
            End If
        Next
    End If
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aEschborn)
            If InStr(1, cell.Value, aEschborn(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
            End If
        Next
    End If
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aCologne)
            If InStr(1, cell.Value, aCologne(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
            End If
        Next
    End If
    If Len(cell.Value) <> 0 Then
        For i = 0 To UBound(aCologne2)
            If InStr(1, cell.Value, aCologne2(i), vbTextCompare) Then
                iMatches = (iMatches + 1)
                Sheets("Germany").Rows(cell.Row).Copy Sheets("GIZ").Rows(iMatches)
            End If
        Next
    End If
Next
End Sub