Macro not Executing. Copy and Paste based on Criteria in Range

[Conell8383]

Hi All I hope you can help.

What I am trying to achieve is for my Macro or code to look through column F. When it finds a country then create a new sheet name it after that country then copy all the information for that country from the Original sheet in this case 'TOV Full Extract with correct D' then look at column F again find the next country create a new sheet name if after the country copy in all the data and so on until the end of column F.

the code i have so far is below

I am getting a run time error 9 on line

Set ws1 = Worksheets("Sheet1")

I have also attached a picture of my Excel sheet any help would be greatly appreciated.

Option Explicit


Sub Filter()


Dim wsCL As Worksheet
Set wsCL = Worksheets("TOV Full Extract with correct D")


Dim rCL As Range, rCountry As Range
Set rCL = wsCL.Range("A1:A201")


Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")


Dim lRow As Long
lRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row


For Each rCountry In rCL


    'check if country exists
    Dim rTest As Range
    Set rTest = ws1.Range("F1:F" & lRow).Find(rCountry.Value2, lookat:=xlWhole)


    If Not rTest Is Nothing Then 'if country is found create sheet and copy data


        Dim wsNew As Worksheet
        Worksheets.Add (ThisWorkbook.Worksheets.Count)
        Set wsNew = ActiveSheet
        wsNew.Name = rCountry.Value2
        ws1.Range("A1:Q1").Copy wsNew.Range("A1") 'place header row


        With ws1.Range("A1:Q" & lRow)
            .AutoFilter 10, rCountry.Value2
            .Offset(1).SpecialCells(xlCellTypeVisible).Copy wsNew.Range("B1") 'copy data for country under header
            .AutoFilter
        End With


    End If


Next


End Sub

 

[steve the fish]

Do you have a sheet called Sheet1?

 

[Conell8383]

@Steve the Fish: I dont and I wont. I suspected that was the issue. Is there a way to change the code to adapt whether there is a sheet1 or not?

 

[steve the fish]

You cant assign a variable to a sheet that doesn't exist! It looks like you want:

Set ws1 = Worksheets("TOV Full Extract with correct D")

but I could be wrong.

 

[Conell8383]

Hi Steve the Fish: thank you for the suggestion but it didn't work If I create the sheet it works fine is there some code that can be entered to create the sheet perhaps?