Copy from one workbook to another including tables

Question

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.

skkakkar · Accepted Answer · 2019-03-07T09:11:30.767

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.

Thank you this seems to work great. I have not done this type of VBA yet so thanks. But the only thing is, i only want it to copy from the second column and 4th row. (B4). There is stuff in Column A and lines 1,2 and 3. — Lalaland, Mar 07 '19 at 08:28
@Lalaland Is your data in a defined table or a simple range. not in table. Further can you upload a sample file with factitious data so that I may test and modify my code to suit your requirements fully. — skkakkar, Mar 07 '19 at 08:42
Hi there, i have uploaded the file i use to copy from, so everything in yellow needs to be copied and pasted to other sheet. — Lalaland, Mar 07 '19 at 09:09
So basically after doing the filter for Magnesium, then the copy will take place but i dont want to copy the actual colum "magnisum". I have highlighted the columns in yellow which should help. — Lalaland, Mar 07 '19 at 09:28
@Lalaland I wanted to make minimum changes to the program routine as it is of universal application and want not to disturb looping portion. I have made minor changes at two places to accomplish your purpose.I have uploaded a word document highlighting changed portion with yellow shade. I hope it should do your job. In case you are satisfied by my efforts for you please accept my answer. Copy from one workbook to another including tables — skkakkar, Mar 07 '19 at 12:24
That is working perfect, thank you so much for all your effort it is really appreciated. — Lalaland, Mar 07 '19 at 12:32
@Lalaland please remove your File upload link from Question as it contains your specific information. — skkakkar, Mar 07 '19 at 13:08

Copy from one workbook to another including tables

1 Answers1