Combining Information - VBA Code

[John_Gil]

Hello Excel masters!

I need to develop a VBA code that brings information from a different file (3 different tabs) and combines everything into one final file.

The final file looks like the table below. We have 7 columns (column 3, 4 and 7 have always the same value):

CustomerAmendments.csv

Shared with Dropbox

www.dropbox.com

The file from where the information is coming has the previous view:

Combined amendments.xlsm

Shared with Dropbox

www.dropbox.com

Steps of the macro:
1- Filter in tabs "NI" and "ROI" column R by "C" and copy the information from columns C, D, I and P;
2- Filter in tab "OCADO" column Q by "C" and copy the information from columns C, D, I and o;
3- Paste information on the final file according with by column order shown in the final file.


I would really appreciate your help guys!

Thank you,
John

 

[JLGWhiz]

I only did limited testing on this.

Sub t()
Dim sh As Worksheet, ary As Variant, i As Long
Set sh = Workbooks("CustomerAmendments").Sheets(1) 'Edit destination sheet name
ary = Array("NI", "ROI", "OCADO")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            .UsedRange.AutoFilter 18, "C"
            .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Copy sh.Cells(Rows.Count, 5).End(xlUp)(2)
            .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            .Range("I2", .Cells(Rows.Count, 9).End(xlUp)).Copy sh.Cells(Rows.Count, 6).End(xlUp)(2)
                If i <> UBound(ary) Then
                    .Range("P2", .Cells(Rows.Count, 16).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                Else
                    .Range("O2", .Cells(Rows.Count, 15).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                End If
            .AutoFilterMode = False
        End With
    Next
End Sub

 

[John_Gil]

Hi @JLGWhiz and thank you so much for your help!

I get a error on the code on the seting part (please see below I highlighted in yellow):

Sub CustomerAmends()
Dim sh As Worksheet, ary As Variant, i As Long
[COLOR=rgb(247, 218, 100)]Set sh = Workbooks("X:\Planning\production plans\production plans\Order Amendments\Combined amendments.xlsm").Sheets(1)[/COLOR] 

ary = Array("NI", "ROI", "OCADO")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            .UsedRange.AutoFilter 17, "C"
            .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Copy sh.Cells(Rows.Count, 5).End(xlUp)(2)
            .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            .Range("I2", .Cells(Rows.Count, 9).End(xlUp)).Copy sh.Cells(Rows.Count, 6).End(xlUp)(2)
                If i <> UBound(ary) Then
                    .Range("P2", .Cells(Rows.Count, 16).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                Else
                    .Range("O2", .Cells(Rows.Count, 15).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                End If
            .AutoFilterMode = False
        End With
    Next
End Sub

Also on the tabs NI and ROI the filter should be on column 18 and on tab OCADO should be on column 17. Could you please make this adjustment as well?

Thank you,
John

 

[Peter_SSs]

please see below I highlighted in yellow)

To manually highlight code you must use the rich tags, not vba tags

 

[John_Gil]

To manually highlight code you must use the rich tags, not vba tags
View attachment 20137

Thank you Peter next time I will know!

 

[JLGWhiz]

This should fix the AutoFilter part.

Sub t()
Dim sh As Worksheet, ary As Variant, i As Long
Set sh = Workbooks("CustomerAmendments").Sheets(1) 'Edit destination sheet name
ary = Array("NI", "ROI", "OCADO")
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
            If i <> UBound(ary) Then
                .UsedRange.AutoFilter 18, "C"
            Else
                .UsedRange.AutoFilter 17, "C"
            End If
            .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Copy sh.Cells(Rows.Count, 5).End(xlUp)(2)
            .Range("D2", .Cells(Rows.Count, 4).End(xlUp)).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            .Range("I2", .Cells(Rows.Count, 9).End(xlUp)).Copy sh.Cells(Rows.Count, 6).End(xlUp)(2)
                If i <> UBound(ary) Then
                    .Range("P2", .Cells(Rows.Count, 16).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                Else
                    .Range("O2", .Cells(Rows.Count, 15).End(xlUp)).Copy sh.Cells(Rows.Count, 2).End(xlUp)(2)
                End If
            .AutoFilterMode = False
        End With
    Next
End Sub

For the 'Set sh' satement, if the workbook is not already open you would get a 'Subscript out of range' error, so you need to either manually open the workbook before running the code or add modify the code with

Dim wb As Workbook
Set wb = Workbooks.Open("X:\Planning\production plans\production plans\Order Amendments\Combined amendments.xlsm")
Set sh = wb.Sheets(1)

 

[JLGWhiz]

Clarification: If the workbook is already open then you only need:

Set sh = Workbooks("Combined amendments.xlsm").Sheets(1)

If it is not open at run time, then you would need to use the Workbooks.Open method using the full path name.

 

[John_Gil]

Looks much better now and no error is displayed but it is still not working. Could it be because on the origin file I have more than only the 3 tabs ("ROI" "NI" and "OCADO")? In the file there are all the tabs in the picture below.

Could this be the issue?

 

[JLGWhiz]

You need to give a better description of the results than "Not working". What is it doing? Is it producing any results and, if so, what are they?
The sheets are called up from an array, so it makes no difference how many you have in the workbook. If you have altered the code I posted, please copy and paste it back to the thread reply window so I can see what you are working with. Don't forget to use the code tags to retain fromatting.

 

[JLGWhiz]

Also, the code needs to be in code module1 or one of the other user inserted code modules, not a sheet, userform or ThisWorkbook module. It is also unclear which workbook you are running the code from.