copy pasting multiple columns from multiple workbooks into one master workbook

mogss_04

Board Regular
Joined
May 9, 2019
Messages
57
Hi can you let me know how to code the below,

I have 3 files named Belarus, Belarus2 and Belarus3 and i need to paste the the below from each of the files into master file.Would it be possible to execute all at once. I have all the files saved in the folder in the path "C:\Users\Priyanka Singh\Desktop\VBA code"

Belarus file to master file
1. "Country" column from Belarus to "Country" in masterfile
2. "Material " column from Belarus to "ITEM_CODE" in master file
3. "Material Name" column from Belarus to "ITEM_DESCR" in master file
4. "Batch" column from Belarus to "LOT_NO" in master file
5. "Manufacturing Date" column from Belarus to "MFG_DATE"
6. "Batch Expiry Date" column from Belarus to "EXP_DATE" in master file
7. "Total Qty column" from Belarus to "QUANTITY" in master file

Belarus2 file to master file
1. "Country" column from Belarus2 to "Country" in masterfile
2. "HANA Code" column from Belarus2 to "ITEM_CODE" in masterfile
3. "Product Name" column from Belarus2 to "ITEM_DESCR" in masterfile
4. "Total Stock Qty" column from Belarus2 to "QUANTITY" in masterfile

Belarus3 file to master file
1. "Country" column from Belarus3 to "Country" in masterfile
2. "Material Code " column from Belarus3 to "ITEM_CODE" in master file
3. "Material " column from Belarus3 to "ITEM_DESCR" in master file
4. "Usage " column from Belarus3 to "Inventory Flag" in master file
5. "Batch Creation Date" column from Belarus3 to "MFG_DATE"
6. "Batch Expiry Date" column from Belarus3 to "EXP_DATE" in master file
7. "Qty Sales Unit (derived from base unit & product description)" column from Belarus3 to "QUANTITY" in master file

Thank you.
 
Hi Mumps,


Yes sure I can do that.I will upload the updated versions where column headers match.


Firsly as per post#36 I had stated below. This is for West file.West file link is below.


https://www.dropbox.com/s/437b14jhqd8vw7c/West.xlsm?dl=0


My next region file involves the below. I will send you the file across for refrence.




path : "C:\Users\Priyanka Singh\Desktop\VBA code1"


I.)First we need to look at Column H - Expired Qty column. Unfilter "0" qty. Then look at "Batch Expiry Date" .






1)December 2019 onwards- Coulmn W should be populated as "Expired" and Column X to be populated as "Restricted"




2)May 2019 - November 2019 - Coulmn W should be populated as "Expired" and Column X to be populated as "Near Expiry"




3)anything before May 2019 - Coulmn W should be populated as "Expired" and Column X to be populated as "Expired"




Next look at column J- Near Expiry Qty. Unfilter "0" qty. For all these quantities Coulmn W should be populated as "Near Expiry" and Column X to be populated as "Near Expiry"




Next look at column N - NET Qty. Unfilter "0" qty.




1. June 2020 onwards - Usable (>12)




2. Dec 2019 - May 2020 - Usable (7-12)




And then same "When "expiry date" is blank or # we need to look at the MFG date and the same rules apply. Exactly the same as expiry date rules except this goes 1 year back.




which is June 2018 onwards - Usable (>12)
Dec 2017 - May 2018 - Usable (7-12)
May 2017- Nov 2017 - Near Expiry
Before May 2017 -




If Manufacturing date and expiry date both are blanks or # present in both then W - Usable and Column X column should be poulated as Usable > 12 "




As per post #44 I want both files to be pasted in Master file. So for West file I want Columns Material-C, Material Name-D, Manufacturing Date-F, Batch Expiry Date- G, Inventory Flag-W and Inv Flag-X from West file to be pasted in Master file under similar headers.




II.) As per post #28 after the MW stock file is ready I want as per post #44 the "Salable Stock" - D and "Salable Stock with Distributor Qty" addition should be pasted in Quantity column G and then column A-Material Code, B-Material, C-Country and G-Quantity should be pasted in Master file under similar headers.




Below is the link for MW stock file.


Path : C:\Users\Priyanka Singh\Desktop\May - Inventory Automation\MW\


https://www.dropbox.com/s/e0gr1ytmhlh4wes/MW Stock.xlsm?dl=0


Below is the link for Master file.


https://www.dropbox.com/s/5jdy0pihmh4vlmx/master file.xlsm?dl=0
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
I'll be out of town for a few days and will look at the files when I get back.
 
Upvote 0
I had a look at your files and the headers in the Master file still do not match the headers in the West and Stock files. I'm willing to try one more time but I need the headers to match exactly. Please upload a new Master file with matching headers.
 
Upvote 0
You said:
May 2019 - November 2019 - Column W should be populated as "Expired" and Column X to be populated as "Near Expiry"
Do you want to hard code the months of May and November? Since we are now in the month of June, would your statement not change to
June 2019 - December 2019 - Column W should be populated as "Expired" and Column X to be populated as "Near Expiry"
In other words are the dates to use not based on the current date?
 
Last edited:
Upvote 0
You are right Mumps.It will change to June 2019 - December 2019.Since I had given you May metric month file and previously stated these months, I continued with that.

It is not supposed to be hard coded.It will be based on current date and month
 
Upvote 0
I think that this will have to be my last try at this. Hopefully, you now have a good idea of how to adapt the macros to suit your needs. First of all, the headers in your files appear to match those in the Master but for some reason the macros don't see them as matching. What I had to do to make sure they match was to delete the headers from the files and copy them from the Master and then pasting them into the other files. In this manner they are sure to match. You may have to do the same thing to make sure the headers in all the files match those ion the Master before you run the macros. Also, in the West file you have some cells with the word "blank" in them. If those cells are supposed to be blank, then delete the text in them.

This macro will update the West file and copy the data into the Master: (run from Master)
Code:
Sub copyColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, srcWS As Worksheet, x As Long, i As Long, LastRow As Long, LastRow2 As Long, rDate As Range
    Set desWS = ThisWorkbook.Sheets("Base inv data")
    Const strPath As String = "C:\Users\Priyanka Singh\Desktop\VBA code1\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsm")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        Set srcWS = Sheets("RM PLANT")
        LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        With srcWS.Cells(1).CurrentRegion
            .AutoFilter 8, ">0"
             For Each rDate In .Range("G2:G" & LastRow).SpecialCells(xlCellTypeVisible)
                If rDate >= DateSerial(Year(Date), Month(Date) + 6, 1) Then
                    rDate.Offset(0, 16) = "Expired"
                    rDate.Offset(0, 17) = "Restricted"
                ElseIf rDate.Value >= DateSerial(Year(Date), Month(Date), 1) And rDate.Value < DateSerial(Year(Date), Month(Date) + 7, 1) Then
                    rDate.Offset(0, 16) = "Expired"
                    rDate.Offset(0, 17) = "Near Expiry"
                ElseIf rDate.Value < DateSerial(Year(Date), Month(Date), 1) Then
                    rDate.Offset(0, 16) = "Expired"
                    rDate.Offset(0, 17) = "Expired"
                End If
            Next rDate
            .AutoFilter
            .AutoFilter 10, ">0"
            srcWS.Range("W2:X" & LastRow).SpecialCells(xlCellTypeVisible) = "Near Expiry"
            .AutoFilter
            .AutoFilter 14, ">0"
            For Each rDate In .Range("G2:G" & LastRow).SpecialCells(xlCellTypeVisible)
                If rDate >= DateSerial(Year(Date) + 1, Month(Date) + 1, 1) Then
                    rDate.Offset(0, 17) = "Usable (>12)"
                ElseIf rDate.Value >= DateSerial(Year(Date), Month(Date) + 7, 1) And rDate.Value < DateSerial(Year(Date) + 1, Month(Date) + 1, 1) Then
                    rDate.Offset(0, 17) = "Usable (7-12)"
                End If
            Next rDate
            .AutoFilter
            .AutoFilter Field:=7, Criteria1:="=#", Operator:=xlOr, Criteria2:="="
             For Each rDate In .Range("F2:F" & LastRow).SpecialCells(xlCellTypeVisible)
                If rDate <> "" Then
                    If rDate >= DateSerial(Year(Date) - 1, Month(Date) + 1, 1) Then
                        rDate.Offset(0, 18) = "Usable (>12)"
                    ElseIf rDate.Value >= DateSerial(Year(Date) - 2, Month(Date) + 7, 1) And rDate.Value < DateSerial(Year(Date) - 1, Month(Date) + 1, 1) Then
                        rDate.Offset(0, 18) = "Usable (7-12)"
                    ElseIf rDate.Value >= DateSerial(Year(Date) - 2, Month(Date), 1) And rDate.Value < DateSerial(Year(Date) - 2, Month(Date) + 7, 1) Then
                        rDate.Offset(0, 18) = "Near Expiry"
                    ElseIf rDate.Value < DateSerial(Year(Date) - 2, Month(Date), 1) Then
                        rDate.Offset(0, 18) = "Expired"
                    End If
                End If
            Next rDate
            
            For Each rDate In .Range("F2:F" & LastRow).SpecialCells(xlCellTypeVisible)
                If (rDate = "" And rDate.Offset(0, 1) = "") Or (rDate = "#" And rDate.Offset(0, 1) = "#") Then
                    rDate.Offset(0, 17) = "Usable"
                    rDate.Offset(0, 18) = "Usable > 12"
                End If
            Next rDate
            .AutoFilter
        End With
        strExtension = Dir
    Loop
    With desWS.Range("C:C,E:E,J:J,K:K,O:O,P:P")
        For i = 1 To .Areas.Count
            LastRow2 = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            x = .Areas(i).Column
            Set Header = srcWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)
            If Not Header Is Nothing Then
                srcWS.Range(srcWS.Cells(2, Header.Column), srcWS.Cells(LastRow, Header.Column)).Copy desWS.Cells(LastRow2, x)
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
This macro copies the data from the Stock file into the Master: (run from Master)
Code:
Sub copyColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, srcWS As Worksheet, x As Long, i As Long, LastRow As Long, LastRow2 As Long, rDate As Range
    Set desWS = ThisWorkbook.Sheets("Base inv data")
    Const strPath As String = "C:\Users\Priyanka Singh\Desktop\May - Inventory Automation\MW\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsm")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
         Set srcWS = Sheets("MW Final")
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS.Range("C:C,E:E,L:L")
                LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                For i = 1 To .Areas.Count
                    x = .Areas(i).Column
                    Set Header = srcWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not Header Is Nothing Then
                        srcWS.Range(srcWS.Cells(2, Header.Column), srcWS.Cells(LastRow, Header.Column)).Copy desWS.Cells(LastRow2, x)
                    End If
                Next i
            End With
            srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
This macro goes into the Stock file and it copies the data from Bal, Bel and Braz files.
Code:
Sub copyColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, srcWS As Worksheet, LastRow As Long, LastRow2 As Long, Header As Range, rng As Range
    Set desWS = ThisWorkbook.Sheets("MW Final")
    Const strPath As String = "C:\Users\Priyanka Singh\Desktop\May - Inventory Automation\MW\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
         Set srcWS = Sheets("Master data")
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS.Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G")
                LastRow2 = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                For Each rng In desWS.Range("A1:G1")
                    Set Header = srcWS.Rows(1).Find(rng, LookIn:=xlValues, lookat:=xlWhole)
                    If Not Header Is Nothing Then
                        srcWS.Range(srcWS.Cells(2, Header.Column), srcWS.Cells(LastRow, Header.Column)).Copy desWS.Cells(LastRow2, rng.Column)
                    End If
                Next rng
            End With
            srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Good luck with your project. :)
 
Last edited:
Upvote 0
Hi Mumps,

Thank you so much Mumps for all the help. You are awesome and couldnt have completed my project without your help.

I was running the above code only for West file, putting the code in Master file. The code seems to run but neither anything is populated in West file nor data gets pasted into Master file. I also tried running the code only in West file, leaving aside the copy paste part of code in Master file. It still doesnt seem to populate values in column W and X.

I just tested for West file. For other regions i have not performed but since we have done it earlier , I will adjust it accordingly and put them in Master file.
 
Upvote 0

Forum statistics

Threads
1,224,745
Messages
6,180,699
Members
452,994
Latest member
Janick

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top