Unable to execute macro

ian0886

New Member
Joined
Dec 10, 2016
Messages
42
Hi Guys,

I'm having some issues trying to run the macro below. I'm trying to copied the filter data from wbI to the each tab on another workbook (tickets). i seem to have missed out something but i can't figure it out. Much appreciated if someone could shed some light. Thanks!
Code:
Sub Trial()    
    SearchCol = "Portfolio"
    Dim rng1 As Range
    Set rng1 = ActiveSheet.UsedRange.Find(SearchCol, , xlValues, xlWhole)
    
    Dim wbI As Workbook
    Dim wsI As Worksheet
    
    Dim c(1 To 5) As String
    c(1) = "LDN"
    c(2) = "TKY"
    c(3) = "NY4"
    c(4) = "POPNY4"
    c(5) = "POP Swap"
    
    Dim ws(1 To 5) As Worksheet
    ws(1) = Workbooks("tickets").Worksheets("T-Data")
    ws(2) = Workbooks("tickets").Worksheets("TY -Data")
    ws(3) = Workbooks("tickets").Worksheets("NY -Data")
    ws(4) = Workbooks("tickets").Worksheets("POPNY4 -Data")
    ws(5) = Workbooks("tickets").Worksheets("POPSWOP -Data")
    
    Set wbI = ActiveWorkbook
    Set wsI = wbI.Sheets("BNP")
    
    Dim counter As Integer
    For counter = 1 To 5
    
    Workbooks("Fx_Activity.csv").Activate
    Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
    
    wsI.Range("a1").CurrentRegion.Copy
    ws(counter).Range("a1").PasteSpecial xlPasteAll, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Next




End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
This doesn't look quite right
Code:
    Workbooks("Fx_Activity.csv").Activate
    Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
    
    wsI.Range("a1").CurrentRegion.Copy
    ws(counter).Range("a1").PasteSpecial xlPasteAll, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Your filtering 1 workbook, but then copying from another.
 
Upvote 0
Hi All,

Thanks first for looking at this. Basically, i'm filtering Workbooks("Fx_Activity.csv") for the criteria c(1) = "LDN" for eg. This was working fine. but i now want to copy this filtered data into another Workbooks("tickets"), on the tab Worksheets("T-Data").

furthermore, this should be repeated to filter and copy to its respective tabs. i dont think i can provide a sample for to try. sorry about that.
 
Upvote 0
This is my updated macro.

Code:
Sub BNPTrial()
    
    SearchCol = "Portfolio"
    Dim rng1 As Range
    Set rng1 = ActiveSheet.UsedRange.Find(SearchCol, , xlValues, xlWhole)
    
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    
    Dim c(1 To 5) As String
    c(1) = "LDN"
    c(2) = "TKY"
    c(3) = "NY4"
    c(4) = "POPNY4"
    c(5) = "POP Swap"
    
    Dim ws(1 To 5) As Worksheet
    ws(1) = Workbooks("tickets").Worksheets("T-Data")
    ws(2) = Workbooks("tickets").Worksheets("TY -Data")
    ws(3) = Workbooks("tickets").Worksheets("NY -Data")
    ws(4) = Workbooks("tickets").Worksheets("POPNY4 -Data")
    ws(5) = Workbooks("tickets").Worksheets("POPSWOP -Data")
    
    Set wbI = ActiveWorkbook
    Set wsI = wbI.Sheets("BNP")
    
    Dim counter As Integer
    For counter = 1 To 5
    
    Workbooks("Fx_Activity.csv").Activate
    Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
    wsI.Range("a1").CurrentRegion.Copy
    
    With Workbooks("tickets").Worksheets("ws(counter)")
    .Clear
    .Range("a1").PasteSpecial xlPasteAll, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    End With
 
    Next
 Application.DisplayAlerts = True
 
End Sub
 
Upvote 0
Try
Code:
 Workbooks("Fx_Activity.csv").Activate
    Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
    Range("a1").CurrentRegion.Copy
 
Upvote 0
hi Fluff,

I've got stuck halfway with the error Subscript of of range. After copying the data, its not able to go to the workbook to clear the contents before pasting the data on each worksheet. Im not too sure if there's somethig that i might have left out.
 
Upvote 0
Try this
Code:
Sub BNPTrial()
    
    SearchCol = "Portfolio"
    Dim rng1 As Range
    Set rng1 = ActiveSheet.UsedRange.Find(SearchCol, , xlValues, xlWhole)
    
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    
    Dim c(1 To 5) As String
    c(1) = "LDN"
    c(2) = "TKY"
    c(3) = "NY4"
    c(4) = "POPNY4"
    c(5) = "POP Swap"
    
    Dim ws(1 To 5) As Worksheet
    ws(1) = Workbooks("tickets").Worksheets("T-Data")
    ws(2) = Workbooks("tickets").Worksheets("TY -Data")
    ws(3) = Workbooks("tickets").Worksheets("NY -Data")
    ws(4) = Workbooks("tickets").Worksheets("POPNY4 -Data")
    ws(5) = Workbooks("tickets").Worksheets("POPSWOP -Data")
    
    Set wbI = ActiveWorkbook
    Set wsI = wbI.Sheets("BNP")
    
    Dim counter As Integer
    For counter = 1 To 5
    
    Workbooks("tickets").Worksheets("ws(counter)").Cells.Clear
    Workbooks("Fx_Activity.csv").Activate
    Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
    Range("a1").CurrentRegion.Copy
    
    With Workbooks("tickets").Worksheets("ws(counter)")
        .Range("a1").PasteSpecial xlPasteAll, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End With
 
    Next
 Application.DisplayAlerts = True
 
End Sub
 
Upvote 0
Hi Fluff,

I'e tried what you've given but its still not running right. I'm not sure if its the way i'm defined my worksheets thats not allowing to run right.

The error is given as Subscription out of range.

Code:
Sub BNPTrial()

Call BNP
    
    SearchCol = "Portfolio"
    Dim rng1 As Range
    Set rng1 = ActiveSheet.UsedRange.Find(SearchCol, , xlValues, xlWhole)
    
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    
    Dim c(1 To 5) As String
    c(1) = "LDN"
    c(2) = "TKY"
    c(3) = "NY4"
    c(4) = "POPNY4"
    c(5) = "POP Swap"
    
    Dim ws(1 To 5) As Worksheet
    ws(1) = Sheets("Treasury BNP -Data")
    ws(2) = Sheets("BNPPB (TY3) -Data")
    ws(3) = Sheets("BNPPB (NY4) -Data")
    ws(4) = Sheets("BNP (POPNY4)-Data")
    ws(5) = Sheets("BNP (POPSWOP)-Data")
    
    Set wbI = ActiveWorkbook
    Set wsI = wbI.Sheets("BNP")
    
    Dim counter As Integer
    For counter = 1 To 5
    
    Workbooks("tickets.xlsm").ws(counter).Cells.Clear
    Workbooks("Fx_Activity.csv").Activate
    Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
    Range("a1").CurrentRegion.Copy
    
    Workbooks("tickets.xlsm").Activate
    With Workbooks("tickets.xlsm")."ws(counter)"
        .Range("a1").PasteSpecial xlPasteAll, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    End With
 
    Next
 Application.DisplayAlerts = True




End Sub
 
Upvote 0
Try this
Code:
Sub BNPTrial()
    
    Dim rng1 As Range
    Dim wbI As Workbook, wbO As Workbook
    Dim c(5) As String
    Dim ws(5) As Worksheet
    Dim counter As Integer

    Set rng1 = ActiveSheet.UsedRange.Find("Portfolio", , xlValues, xlWhole)
    Set wbI = ActiveWorkbook
    Set wbO = Workbooks("tickets.[COLOR=#ff0000]xlsx[/COLOR]")
    
    c(1) = "LDN"
    c(2) = "TKY"
    c(3) = "NY4"
    c(4) = "POPNY4"
    c(5) = "POP Swap"
    
    Set ws(1) = wbO.Worksheets("T-Data")
    Set ws(2) = wbO.Worksheets("TY -Data")
    Set ws(3) = wbO.Worksheets("NY -Data")
    Set ws(4) = wbO.Worksheets("POPNY4 -Data")
    Set ws(5) = wbO.Worksheets("POPSWOP -Data")
    
    For counter = 1 To 5
       ws(counter).Cells.Clear
       wbI.Activate
       Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
       Range("a1").CurrentRegion.Copy
       
       With ws(counter)
           .Range("a1").PasteSpecial xlPasteAll, Operation:=xlNone, _
               SkipBlanks:=False, Transpose:=False
       End With
    Next counter
    
 Application.DisplayAlerts = True
 
End Sub
You'll need to check the file extension in red & change if needed.
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,064
Members
448,545
Latest member
kj9

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top