VBA to a specific workbook.

[Keibri]

Hi all,

I have the following code which basically allows for advanced filtering to be done through VBA. If possible, I would like to run this macro to another workbook which is not yet active i.e. it is closed.

I think that what needs to be done is to adjust the code so as to open the specific workbook, run this code and then save the workbook and close it again.


Can someone guide me through!?

Thanks a lot!!

Option Explicit


Sub Filter_Copy()
   
   Dim LR           As Long
   Dim ws           As Worksheet
    
    Set ws = Sheets("Sheet2")


   With ws
      LR = .Range("D" & .Rows.Count).End(xlUp).Row
   End With
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   On Error Resume Next
   Sheets("Lists").Delete
   On Error GoTo 0
   Application.DisplayAlerts = True
   
   
    Sheets("Archive").Range("A1:D600").ClearContents
  
   With ActiveSheet
      ws.Range("A4:D600" & LR).AdvancedFilter Action:=xlFilterCopy _
         , CriteriaRange:=Sheets("Sheet2").Range("A1:D2"), CopyToRange:=Sheets("Archive").Range("A1"), Unique:=True


   
   End With
   
   
End Sub

 

[jim may]

Modifications in RED:

Test this on a COPY of your File, NOT THE ORIGINAL..

Sub Filter_Copy()
   
   Dim LR As Long
   Dim ws As Worksheet
   Dim wb As Workbook
   Dim sFile As String
   sFile = "C:\Users\Owner\Documents\MrExcel\MyTestFile.xlsx"  ' Change this to your Destination file path
   Workbooks.Open sFile
   Set wb = ActiveWorkbook
   
    Set ws = Sheets("Sheet2")

   With ws
      LR = .Range("D" & .Rows.Count).End(xlUp).Row
   End With
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   On Error Resume Next
   Sheets("Lists").Delete
   On Error GoTo 0
   Application.DisplayAlerts = True
   
   
    Sheets("Archive").Range("A1:D600").ClearContents
  
   With ActiveSheet
      ws.Range("A4:D600" & LR).AdvancedFilter Action:=xlFilterCopy _
         , CriteriaRange:=Sheets("Sheet2").Range("A1:D2"), CopyToRange:=Sheets("Archive").Range("A1"), Unique:=True
    wb.Save
    wb.Close
   Application.ScreenUpdating = True
   End With

End Sub

 

[Keibri]

Thanks that solved it! Awesome

Really appreciate it !