Page 3 of 7 FirstFirst 12345 ... LastLast
Results 21 to 30 of 63

Thread: copy pasting multiple columns from multiple workbooks into one master workbook
Thanks Thanks: 0 Likes Likes: 0

  1. #21
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    7,858
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    5 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    What do you want to do with the Belarus 3 workbook after column N had been populated? Do you want to save it?
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  2. #22
    Board Regular
    Join Date
    May 2019
    Posts
    57
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    Yes i want to save it and then use the same file to create the master file as i mentioned in my previous post.

  3. #23
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    7,858
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    5 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    In the Master file you have these headers: ITEM_CODE ITEM_DESCR Country MFG_DATE EXP_DATE
    You want to copy theses columns: "country", "Material Code", "Material", "Batch Creation Date", "Batch Expiry Date" from each Belarus file but as you can see, the headers don't match. It would make it much easier to write the code if the headers matched. Would it be a problem if we changed the headers in the Master file to match the headers in the Belarus files?
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  4. #24
    Board Regular
    Join Date
    May 2019
    Posts
    57
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    Yes we can keep the headers of the master file same as the headers which are there in Belarus files. It wouldnt be a issue

  5. #25
    Board Regular
    Join Date
    May 2019
    Posts
    57
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    Hi mumps,

    Awaiting your reply on the above. Can we code the above now given the headers would be the same in the master file or are there any other issues in the file which i need to look into before you start coding.Let me know for any other issues.

    Thank you.

  6. #26
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    7,858
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    5 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    I have the code to copy the columns finished. I'm working on the dates. I always find working with dates tricky so I'm testing that part of the code. Hopefully, I should have something for you soon.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  7. #27
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    7,858
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    5 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    Here is the macro. Change the headers in the Master to match those in the Belarus files. In the Belarus 3 file you have an option called "Restricted-Use" which will leave blank cells in column N because you didn't mention anything about this option. Also, in the Belarus 3 file, you have blank cells in columns B and C starting in row 1440. This will cause a problem if these cells are left blank. If they need to be blank, then the macro will have to be modified. Please advise. Please check the results in column N to make sure they are what you want.
    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, 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 & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            If srcWB.Name = "Belarus 3.xlsx" Then
                Set srcWS = Sheets("base")
                LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                With desWS.Range("C:C,E:E,F:F,J:J,K:K")
                    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(desWS.Rows.Count, x).End(xlUp).Offset(1, 0)
                        End If
                    Next i
                End With
                With srcWS
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="=Unrestricted Use", Operator:=xlOr, Criteria2:="=Unrestricted-Use Mat"
                    For Each rDate In .Range("M2:M" & LastRow).SpecialCells(xlCellTypeVisible)
                        If rDate.Value > DateSerial(Year(Date) + 1, Month(Date), Day(Date)) Then
                            rDate.Offset(0, 1) = "Usable (>12)"
                        ElseIf rDate.Value > DateSerial(Year(Date), Month(Date) + 7, Day(Date)) And rDate.Value < DateSerial(Year(Date) + 1, Month(Date), Day(Date)) Then
                            rDate.Offset(0, 1) = "Usable (7-12)"
                        ElseIf rDate.Value > DateSerial(Year(Date), Month(Date), Day(Date)) And rDate.Value < DateSerial(Year(Date), Month(Date) + 7, Day(Date)) Then
                            rDate.Offset(0, 1) = "Near expiry"
                        ElseIf rDate.Value < Date Then
                            rDate.Offset(0, 1) = "Expired"
                        End If
                    Next rDate
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Blocked Stock", Operator:=xlOr, Criteria2:="Valuated Goods Receipt Blocked Stock"
                    .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Blocked"
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Transit", Operator:=xlOr, Criteria2:="Intransit"
                    .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Transit"
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Quality inspection"
                    .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Quality inspection"
                    .Range("B1").AutoFilter
                    srcWB.Close True
                End With
            Else
                Set srcWS = Sheets("base")
                LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                With desWS.Range("C:C,E:E,F:F,J:J,K:K")
                    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(desWS.Rows.Count, x).End(xlUp).Offset(1, 0)
                        End If
                    Next i
                End With
                srcWB.Close False
            End If
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  8. #28
    Board Regular
    Join Date
    May 2019
    Posts
    57
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    Hi Mumps,


    Thank you so much for looking into the above.


    1. For option called "Restricted-Use" it is Restricted that should be populated in column N. I added that in the code. It works fine.


    2. And yes we can have blank columns. For certain products Item code wouldnt exist and other way round so the blanks need to be there the way it is.


    3. And for copying columns the code works in this file. However I had certain questions. Do the columns which exist in the master file have to be present in all source files. If one of the columns which needs to be copied in master files are missing in the source files, will the code work?


    Also this was for one of the regions that is Belarus. I tried similar code for other region but it doesnt copy paste one of the columns that is "Salable Stock". Also while you were looking into the coding I had tried coding the copy pasting based on column names on own.The source files may not have all the columns which are to be pasted in master file.But if the columns which exist in master file are found , they should be pasted and if not found left blank for those records the columns which are not found. My code as well as your code doesnt paste the "Salable Stock" column from source files into master file. I dont know what is the issue. Can you look into the code below. I shall upload the files.I have both codes in the master file. Your code in Module 2 and mine in Module 1.I am uploading 4 files for reference although there 8 such files. 3 source files and 1 master file.


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


    https://www.dropbox.com/s/e0gr1ytmhl...tock.xlsm?dl=0

    https://www.dropbox.com/s/1kwjwlr16p...Braz.xlsx?dl=0

    https://www.dropbox.com/s/cqdg403jw2...0BAL.xlsx?dl=0

    https://www.dropbox.com/s/m1tluslskr...0Bel.xlsx?dl=0




    4. For column N under as i Had mentioned below in post#15


    "if the expiry date falls 12 months after the the current month i.e 2020 June onwards then column N should be polpulated as"Usable (>12)", if expiry date falls between 7 - 12 months after expiry date
    which is from December 2019 - May 2020 then column N should be polpulated as"Usable (7-12)"


    I see that expiry date falling under May 2020 is populated under "Usable(>12)" instead of "Usable (7-12)" . This is for all expiry date falling on "5/31/2020". If you filter the sheet by this expiry date , there are some 15 records . Could you please help fix this.Rest the code works well. Thank you so much once again.

  9. #29
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    7,858
    Post Thanks / Like
    Mentioned
    83 Post(s)
    Tagged
    5 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    Try this revised macro for the Belarus files.
    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\"
        Const strPath As String = "C:\Forum Help\mogss\"
        ChDir strPath
        strExtension = Dir(strPath & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            If srcWB.Name = "Belarus 3.xlsx" Then
                Set srcWS = Sheets("base")
                LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                With desWS.Range("C:C,E:E,F:F,J:J,K:K")
                    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
                With srcWS
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="=Unrestricted Use", Operator:=xlOr, Criteria2:="=Unrestricted-Use Mat"
                    For Each rDate In .Range("M2:M" & LastRow).SpecialCells(xlCellTypeVisible)
                        If rDate.Value > DateSerial(Year(Date) + 1, Month(Date) + 1, 1) Then
                            rDate.Offset(0, 1) = "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, 1) = "Usable (7-12)"
                        ElseIf rDate.Value > DateSerial(Year(Date), Month(Date), 1) And rDate.Value < DateSerial(Year(Date), Month(Date) + 7, 1) Then
                            rDate.Offset(0, 1) = "Near expiry"
                        ElseIf rDate.Value < DateSerial(Year(Date), Month(Date), 1) Then
                            rDate.Offset(0, 1) = "Expired"
                        End If
                    Next rDate
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Blocked Stock", Operator:=xlOr, Criteria2:="Valuated Goods Receipt Blocked Stock"
                    .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Blocked"
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Transit", Operator:=xlOr, Criteria2:="Intransit"
                    .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Transit"
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Quality inspection"
                    .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Quality inspection"
                    .Range("B1:N" & LastRow).AutoFilter Field:=8, Criteria1:="Restricted-Use"
                    .Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible) = "Restricted"
                    .Range("B1").AutoFilter
                    srcWB.Close True
                End With
            Else
                Set srcWS = Sheets("base")
                LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                With desWS.Range("C:C,E:E,F:F,J:J,K:K")
                    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
                srcWB.Close False
            End If
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    I'll work on the code for the other region tomorrow.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  10. #30
    Board Regular
    Join Date
    May 2019
    Posts
    57
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: copy pasting multiple columns from multiple workbooks into one master workbook

    Sure. Will do.

    The above code works fine. Thank you so much

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •