Unable to execute macro

ian0886

New Member
Joined
Dec 10, 2016
Messages
41
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,332
Office Version
365
Platform
Windows
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.
 

ian0886

New Member
Joined
Dec 10, 2016
Messages
41
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.
 

ian0886

New Member
Joined
Dec 10, 2016
Messages
41
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,332
Office Version
365
Platform
Windows
Try
Code:
 Workbooks("Fx_Activity.csv").Activate
    Range("a1").AutoFilter Field:=rng1.Column, Criteria1:=c(counter)
    Range("a1").CurrentRegion.Copy
 

ian0886

New Member
Joined
Dec 10, 2016
Messages
41
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.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,332
Office Version
365
Platform
Windows
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
 

ian0886

New Member
Joined
Dec 10, 2016
Messages
41
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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
32,332
Office Version
365
Platform
Windows
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.
 

Forum statistics

Threads
1,082,359
Messages
5,364,916
Members
400,815
Latest member
Joaquin Phoenix

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top