VBA to copy certain columns from multiple workbooks with multiple worksheet based on criteria into master workbook

[nathanmav]

Hi everyone,

I would like to ask for help about the code I found and I tried to modify it but I'm not lucky to make it work.
I have a total of eight (8) workbooks with more than one (1) worksheets. What I'm trying to achieved is copy a certain column if the condition is met.

Here is the code:

Sub copydata()
   
    Dim lastrow As Integer
    Dim i As Integer As Integer
    Dim erow As Integer
    Dim xlsDestination As Workbook  'Master Workbook
    Dim xlsSource As Workbook       'Source Workbook
    Dim xlsDestSheet As Worksheet   'Destination Sheet
    Dim xlsSourceSheet As Worksheet 'Source Sheet
    Dim RefNo, Rev, Desc, DateSub

    Application.ScreenUpdating = False
       
    Set xlsDestination = ThisWorkbook
    Set xlsDestSheet = xlsDestination.Sheets("Master")
   
    Set xlsSource = Workbooks.Open("C:\Users\User\Desktop\Report\Source1.xlsx") 'I have lots of source workbooks
    Set xlsSourceSheet = xlsSource.Sheets("Sheet1") 'The problem here is source file composed of more than 1 sheet in every workbooks
   
    lastrow = xlsDestSheet.Range("A" & Rows.Count).End(xlUp).Row

    For i = 12 To lastrow 'starting row to copy in Source File
        If xlsSourceSheet.Cells(i, 13).Value = "C" And xlsSourceSheet.Cells(i, 17).Value = "LT" Then ' This the condition if condition is met
            'change the column numbers to the relevant number (from Source Workbook)
            RefNo = xlsSourceSheet.Cells(i, 2).Value
            Rev = xlsSourceSheet.Cells(i, 3).Value
            Desc = xlsSourceSheet.Cells(i, 5).Value
            DateSub = xlsSourceSheet.Cells(i, 10).Value

            erow = xlsDestSheet.Cells(xlsDestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row

            'change the column numbers to the relevant number (to Master Workbook)
            xlsDestSheet.Cells(erow, 4).Value = RefNo
            xlsDestSheet.Cells(erow, 5).Value = Rev
            xlsDestSheet.Cells(erow, 6).Value = Desc
            xlsDestSheet.Cells(erow, 7).Value = DateSub
        End If
    Next i
Application.ScreenUpdating = True

End Sub

Thank you in advance!

 

[nathanmav]

Are the workbooks protected or are the sheets protected?

Workbooks are password protected.

 

[nathanmav]

I notice that there are some conflict in the range because source file have different no. of columns.

OVERDUE sheet in destination workbook:

FOR ACTION sheet in destination workbook:

 

[mumps]

I'm sorry but I don't think that I can help any further unless there is some sort of consistency in how the source files are organized. Currently, the location of the columns you want to copy can be anywhere on the sheet. Also the column headers in row 11 of those columns are not the same in the source files. If you can modify the location of the columns in question so that they are always in the same place or modify the column headers in those columns so that they are the same in all the source files, then perhaps a working solution can be found.

 

[nathanmav]

I'm sorry but I don't think that I can help any further unless there is some sort of consistency in how the source files are organized. Currently, the location of the columns you want to copy can be anywhere on the sheet. Also the column headers in row 11 of those columns are not the same in the source files. If you can modify the location of the columns in question so that they are always in the same place or modify the column headers in those columns so that they are the same in all the source files, then perhaps a working solution can be found.

The source files are all different and can't be same number of columns. The only way that I can fixed is the header I can make it all in row 11.

Thank you

 

[nathanmav]

Is that possible that the range can define by column name when copying from to destination because all my source files are in a table.

 

[mumps]

In Source1, the headers in J11 and L11 are ASUBDATE and AREPDATE. The headers in Source3 in G11 and H11 are SUB DATE and REP DATE. As you can see, they are not the same. The header names of the columns you want to copy must all be the same in all the source files and in the same row.

 

[nathanmav]

I tried this code for OVERDUE sheet but it search only in one(1) source and one(1) sheet.
Then change the reference for the FOR ACTION Sheet.

Sub OVERDUE()
  
    Dim lastrow As Integer
    Dim i As Integer
    Dim erow As Integer
    Dim xlsDestination As Workbook  'Master Workbook
    Dim xlsSource As Workbook       'Source Workbook
    Dim xlsDestSheet As Worksheet   'Destination Sheet
    Dim xlsSourceSheet As Worksheet 'Source Sheet
    Dim RefNo, Rev, Desc, DateSub

    Application.ScreenUpdating = False
      
    Set xlsDestination = ThisWorkbook
    Set xlsDestSheet = xlsDestination.Sheets("OVERDUE")
  
    Set xlsSource = Workbooks.Open("C:\Users\User\Desktop\Sample\Source1.xlsx") 'I have lots of source workbooks
    Set xlsSourceSheet = xlsSource.Sheets("CV") 'The problem here is source file composed of more than 1 sheet in every workbooks
  
    lastrow = xlsDestSheet.Range("A" & Rows.Count).End(xlUp).Row

    For i = 12 To lastrow 'starting row to copy in Source File
        If xlsSourceSheet.Cells(i, 17).Value = "OVERDUE" Then ' This the condition if condition is met
            'change the column numbers to the relevant number (from Source Workbook)
            RefNo = xlsSourceSheet.Cells(i, 2).Value
            Rev = xlsSourceSheet.Cells(i, 3).Value
            Desc = xlsSourceSheet.Cells(i, 5).Value
            DateSub = xlsSourceSheet.Cells(i, 10).Value

            erow = xlsDestSheet.Cells(xlsDestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0).Row

            'change the column numbers to the relevant number (to Master Workbook)
            xlsDestSheet.Cells(erow, 4).Value = RefNo
            xlsDestSheet.Cells(erow, 5).Value = Rev
            xlsDestSheet.Cells(erow, 6).Value = Desc
            xlsDestSheet.Cells(erow, 7).Value = DateSub
        End If
    Next i
Application.ScreenUpdating = True

End Sub

 

[mumps]

If you want to copy the data from all the sheets in all the source files, you will have to make the header names the same. See Post #16. If you are unable to do that, I'm afraid I won't be able to help.

 

[nathanmav]

If you want to copy the data from all the sheets in all the source files, you will have to make the header names the same. See Post #16. If you are unable to do that, I'm afraid I won't be able to help.

I can make it all headers have the same name.

Thank you

 

[mumps]

Please list the header names of the columns you want to copy as they will appear in all the source files.