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