Sub CopyRow() Dim c As Range Dim j As Long Dim Source As Worksheet Dim Target As Worksheet Dim sourceRLimit As Long Dim LastRow As Long Dim Lastrowa As Long Set Source = ActiveWorkbook.Worksheets("Source") sourceRLimit = Worksheets("Source").UsedRange.Rows.Count "No need for this to be done twice" LastRow = Application.Max(.Cells(.Rows.Count, “B”).End(xlUp).Row, _ .Cells(.Rows.Count, “B”).End(xlUp).Row) j = 2 For Each c In Source.Range("B1:B" & LastRow) If Left(c, 2) = "43" Then Set Target = ActiveWorkbook.Worksheets("Austria") Source.Rows(c.Row).Copy Target.Rows(j) Lastrowa = Sheets("Austria").Cells(Rows.Count, "B").End(xlUp).Row Application.Union(Cells(i, "A"), Cells(i, "B"), Cells(i, "C"), Cells(i, "D")).Copy Destination:=Sheets("Austria").Range("A" & Lastrowa) Lastrowa = Lastrowa + 1 ElseIf Left(c, 2) = "32" Then Set Target = ActiveWorkbook.Worksheets("BELGIUM") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 2) = "45" Then Set Target = ActiveWorkbook.Worksheets("DENMARK") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "359" Then Set Target = ActiveWorkbook.Worksheets("BULGARIA") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "357" Then Set Target = ActiveWorkbook.Worksheets("CYPRUS") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "372" Then Set Target = ActiveWorkbook.Worksheets("ESTONIA") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "358" Then Set Target = ActiveWorkbook.Worksheets("FINLAND") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 2) = "33" Then Set Target = ActiveWorkbook.Worksheets("FRANCE") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 2) = "49" Then Set Target = ActiveWorkbook.Worksheets("GERMANY") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 2) = "30" Then Set Target = ActiveWorkbook.Worksheets("GREECE") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 2) = "36" Then Set Target = ActiveWorkbook.Worksheets("HUNGARY") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "354" Then Set Target = ActiveWorkbook.Worksheets("Iceland") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "353" Then Set Target = ActiveWorkbook.Worksheets("Ireland") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 2) = "39" Then Set Target = ActiveWorkbook.Worksheets("Italy") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "962" Then Set Target = ActiveWorkbook.Worksheets("Jordan") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "965" Then Set Target = ActiveWorkbook.Worksheets("Kuwait") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "961" Then Set Target = ActiveWorkbook.Worksheets("Lebanon") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "423" Then Set Target = ActiveWorkbook.Worksheets("Liechtenstein") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "352" Then Set Target = ActiveWorkbook.Worksheets("Luxembourg") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "389" Then Set Target = ActiveWorkbook.Worksheets("Macedonia") Source.Rows(c.Row).Copy Target.Rows(j) ElseIf Left(c, 3) = "377" Then Set Target = ActiveWorkbook.Worksheets("Monaco") Source.Rows(c.Row).Copy Target.Rows(j) End If j = j + 1 Next c End Sub
Bookmarks