Hi
I have the following code: Which when its run it looks in AC for a value i.e RDA Uk and when it finds it it copies the row and then pastes in "UK". It will continue until it finds "", then it will move on to the next value and do the same again. I have 6/7 values to find and move to another sheet.
Can anyone help edit to code to help the macro to run quicker?
Sub CountryLoop()
'Uk
Sheets("Combined").Select
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA UK" Then
ActiveCell.EntireRow.Copy
Sheets("UK").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("UK").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
Sheets("Combined").Select
'Benelux
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA Benelux" Then
ActiveCell.EntireRow.Copy
Sheets("Bene").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("Bene").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
Sheets("Combined").Select
'iberia
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA Iberia" Then
ActiveCell.EntireRow.Copy
Sheets("IBE").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("IBE").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
Sheets("Combined").Select
'Germany
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA Germany" Then
ActiveCell.EntireRow.Copy
Sheets("GER").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("GER").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
Sheets("Combined").Select
'France
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA France" Then
ActiveCell.EntireRow.Copy
Sheets("FRA").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("FRA").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
Sheets("Combined").Select
'Finland
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA Finland" Then
ActiveCell.EntireRow.Copy
Sheets("FIN").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("FIN").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
Sheets("Combined").Select
'Romania
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA Romaina" Then
ActiveCell.EntireRow.Copy
Sheets("CE").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("CE").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
Sheets("Combined").Select
'CE Region
[AC1].Select
Do Until ActiveCell = ""
If ActiveCell = "RDA CE Region" Then
ActiveCell.EntireRow.Copy
Sheets("CE").Select
[A65536].Select
Selection.End(xlUp).Select
If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Combined").Select
Else
End If
ActiveCell.Offset(1, 0).Select
Loop
[a1].Select
Sheets("CE").Select
Cells.Columns.AutoFit
Cells.Rows.AutoFit
ActiveCell.Select
'
End Sub
Bookmarks