Lalaland
Lalaland

Reputation: 308

Copy from one workbook to another including tables

So I am trying to copy data from one workbook to another. The sheet where the data is at is in Table form but when i try the below code it does not work. Before the copy happens, it first does a filter and then copies the data.

Sub Details()
Dim x As Workbook
Dim y As Workbook

'## Open both workbooks first:
Set x = Workbooks("C:\Users\user\Desktop\mi\Extracts.xlsm")
Set y = Workbooks("C:\Users\user\Desktop\mi\Outstanding.xlsm")


    x.Sheets.ListObjects("FIdetails").Range.AutoFilter Field:=1

    x.Sheets.ListObjects("FIdetails").Range.AutoFilter Field:=1, Criteria1:= _
        "Magnesium"

        lastCol = ActiveSheet.Range("b4").End(xlToRight).Column
    Lastrow = ActiveSheet.Cells(4, 1).End(xlDown).Row
    ActiveSheet.Range("b4", ActiveSheet.Cells(Lastrow, lastCol)).Copy

'paste to y worksheet:
y.Sheets("Details").Range("A2").Paste


End Sub

Any help would be great thanks.

Upvotes: 0

Views: 71

Answers (1)

skkakkar
skkakkar

Reputation: 2828

Please note following points regarding your code

  • a) x.Sheets.ListObjects does not identify variables and their association correctly and would give compiler error whereas x.ActiveSheet.ListObjects is correct.
  • b) Repetition of Filter line twice is not understandable.

  • c) You have to use visibleCells property for copying filtered cells in your method.

  • d) You have to either Activate the sheet to be worked upon or use With ... End with structure. Later one is a preferable approach.

  • e) To clear filter use ShowAlldata property.

I recorded a macro to demonstrate its potential.

  Sub Macro()
'
' Macro6 Macro
'

'
    Cells.Select
    Application.Goto Reference:="FIdetails"
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.ListObjects("FIdetails").Range.AutoFilter Field:=1, Criteria1:= _
        "magnesium"
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Windows("Outstanding.xlsm").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Windows("Extracts.xlsm").Activate
    Cells.Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
End Sub

Subsequently if you run the program it generates error particularly on line Application.Goto Reference:="FIdetails" and also is not reliable in performance. Further it uses 'Select' which preferably be avoided keeping in view following highly acclaimed SO Posts.

What is the reason not to use select *?

Why is SELECT * considered harmful?

Finally I chose array based approach, which I think may give better & consistent results.

Try This:

    Sub Details()
    Dim Results As Variant, tmp As Variant
    Dim i As Long, j As Long
    Dim CriteriaCol As Long, ResultCount As Long
    Dim Criteria As String

    Criteria = "Magnesium"
    CriteriaCol = 1

    With Sheet1.ListObjects("FIdetails")
        tmp = .DataBodyRange
    End With

    ReDim Results(LBound(tmp, 2) To UBound(tmp, 2), LBound(tmp, 1) To UBound(tmp, 1))
    For i = LBound(tmp, 1) To UBound(tmp, 1)
        If UCase(tmp(i, CriteriaCol)) = UCase(Criteria) Then
            ResultCount = ResultCount + 1
            j = LBound(tmp, 2) - 1
            Do
                j = j + 1
                Results(j, ResultCount) = tmp(i, j)
            Loop Until j = UBound(tmp, 2)
        End If
    Next i
    ReDim Preserve Results(LBound(Results, 1) To UBound(Results, 1), LBound(Results, 1) To ResultCount)
    With Workbooks("Outstanding.xlsm").Sheets("Details")
        .Cells(2, 1).Resize(UBound(Results, 2), UBound(Results, 1)) = Application.Transpose(Results)
    End With
End Sub

EDIT Screenshots of sample data and results added for OP's guidance based on his comments dated 07-03-2019. filter1 filter2

Upvotes: 2

Related Questions