Alternative to Loop

Hi

I have the following code but it takes an age to run, can anyone help simplifiy it. The code looks for something in AC finds it and pastes it into another sheet.

I have a spreadsheet which has 7 regions i need the macro to move each region to a certain sheet i.e RDA UK to UK etc.

Thanks in advance

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

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

What does Country loop mean The thread title should reflect an indication of the question, what results would you expect to find with that title as a search string in Google?

This is a duplicate post and as such does not comply with Rule 5 of our forum rules. This thread will now be closed, you may continue in your other thread.

Thread Closed.

http://www.excelforum.com/excel-prog...ge-to-run.html