Copy Autofilter Source Workbook A result in Destination Workbook BSheet1

[u473]

I need to copy the result from Autofilter on Source Workbook A in
Destination Workbook B Sheet1
My VBA AutoFilter Code is in an external Menu Workbook
..
Sub Import()
Dim fso As Object
Dim Source As Object ' Source Folder path
Dim Dest As Object ' Destination Folder Path
Dim WBA as Object ' Source Workbook
Dim WBB as object ' Destination Workbook
Dim LastRow As Long, Dim Rng As Range
'
Set fso = CreateObject("Scripting.FileSystemObject")
Set Source = fso.GetFolder("P:\Invoices")
WBA = "A.xls"
WBB = "B.xls"
Workbooks.Open Filename:=WBA.Path
On Error GoTo 0
LastRow = Range("B65335").End(xlUp).Row: Range("B2").Select
ActiveSheet.Range("$A$2:$W$65535").AutoFilter Field:=2,
Criteria1:="=Open", Operator:=xlOr, Criteria2:="=Re-Submitted"
'
Set Rng = Range("B2").Resize(LastRow - 1)
Workbooks(WBA.Name).Close False
Workbooks.Open Filename:=WBB.Path
'Syntax problem here
Rng.Copy .....
Workbooks(WBB.Name).Close False
End Sub

Help appreciated
J.P.

 

[Dave Peterson]

Untested, but it did compile:

Option Explicit
Sub Import2()

Dim WBA As Workbook
Dim WBB As Workbook
Dim LastRow As Long
Dim Rng As Range
Dim myPath As String
Dim RngToCopy As Range
Dim DestCell As Range

myPath = "P:\invoices"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
Set WBA = Nothing
On Error Resume Next
Set WBA = Workbooks.Open(myPath & "A.xls")
On Error GoTo 0

If WBA Is Nothing Then
MsgBox "WBA wasn't found!"
Exit Sub
End If
Set WBB = Nothing
On Error Resume Next
Set WBB = Workbooks.Open(myPath & "b.xls")
On Error GoTo 0
If WBB Is Nothing Then
MsgBox "WBb wasn't found!"
Exit Sub
End If

'change to the correct sheet name
With WBA.Worksheets("sheet1")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
.AutoFilterMode = False
'just filter by column B
.Range("b1:b" & LastRow).AutoFilter _
field:=1, criteria:="Open", _
Operator:=xlOr, Criteria2:="Re-Submitted"

If .AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
MsgBox "Only headers are visible"
Exit Sub
End If

With .AutoFilter.Range
Set RngToCopy = .Resize(.Rows.Count, 1).Offset(1, 0) _
.SpecialCells(xlCellTypeVisible).EntireRow
End With
End With

'change to the correct sheet name
With WBB.Worksheets("sheet2")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set DestCell = .Cells(LastRow + 1, "A")
End With

RngToCopy.Copy _
Destination:=DestCell

'close the sending workbook without saving
WBA.Close savechanges:=False

'I would think you'd want to save your changes in WBB!
WBB.Close savechanges:=True

End Sub

Test it before you trust it!!!!