Aranell

08-21-2013, 06:48 AM

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

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