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

nathanmav

Board Regular
Joined
Dec 11, 2012
Messages
117
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:
VBA 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!
 

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

nathanmav

Board Regular
Joined
Dec 11, 2012
Messages
117
I notice that there are some conflict in the range because source file have different no. of columns.

OVERDUE sheet in destination workbook:
overdue destination.JPG


FOR ACTION sheet in destination workbook:
for action destination.JPG
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
9,588
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

Board Regular
Joined
Dec 11, 2012
Messages
117
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

Board Regular
Joined
Dec 11, 2012
Messages
117

ADVERTISEMENT

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

Well-known Member
Joined
Apr 11, 2012
Messages
9,588
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

Board Regular
Joined
Dec 11, 2012
Messages
117

ADVERTISEMENT

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.

VBA Code:
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

Well-known Member
Joined
Apr 11, 2012
Messages
9,588
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

Board Regular
Joined
Dec 11, 2012
Messages
117
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

Well-known Member
Joined
Apr 11, 2012
Messages
9,588
Please list the header names of the columns you want to copy as they will appear in all the source files.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,181
Messages
5,527,278
Members
409,756
Latest member
punknwilly

This Week's Hot Topics

Top