VBA code to copy ranges from 3 sheets into one summary sheet.

[mopo600]

Hi all,

Very new to VBA, would appreciate any help/feedback.

I have 3 sheets under one workbook all under the same formatted heading in source workbook (4. Summer 17 Master Chart). The sheets are named RETAIL, OUTLET, SPECIAL SALES.

I want to add a button in the sheet "COSTING LP" in my target workbook (NEW LINE PLAN TEMP). The button would copy all the data under the headings from all 3 source sheets and paste them all as values in the "DATA" tab in the target workbook so I can have one consolidated chart. The DATA tab has the same formatted headings as the source sheets. What is the best way to go about this?

Thanks!

 

[mopo600]

Adding another source workbook and deleting the previous pasted data should not be a problem. Can you explain in detail what you mean by: After the data from all the 6 sheets is copied to the "DATA" sheet, do you want to add a column to the "DATA" sheet with the header "Division" in row 1and then fill that column with the formula?

Yes exactly!

 

[mumps]

Try this macro. The formula will start in row 13 and then down to the last row with data. Make sure all workbooks are open.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim lColumn As Long
    lColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Dim srcWb1 As Workbook
    Set srcWb1 = Workbooks("4. Summer 17 Master Chart.xlsx")
    Dim srcWb2 As Workbook
    Set srcWb2 = Workbooks("4. Fall 17 Master Chart.xlsx")
    Dim ws As Worksheet
    For Each ws In srcWb1.Sheets(Array("RETAIL", "OUTLET", "SPECIAL SALES"))
        ws.UsedRange.Offset(12, 0).Cells.Copy
        Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Next ws
    For Each ws In srcWb2.Sheets(Array("RETAIL", "OUTLET", "SPECIAL SALES"))
        ws.UsedRange.Offset(12, 0).Cells.Copy
        Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Next ws
    LastRow = Sheets("DATA").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lColumn = Sheets("DATA").Cells(1, Columns.Count).End(xlToLeft).Column
    Sheets("DATA").Cells(1, lColumn + 1) = "Division"
    Sheets("DATA").Cells(13, lColumn + 1).Formula = "=IF(OR(LEFT(B2,2)=""7W"",LEFT(B2,2)=""7Q""),""W"",IF(OR(LEFT(B2,2)=""7M"",LEFT(B2,2)=""7Y""),""M"",""""))"
    Sheets("DATA").Cells(13, lColumn + 1).AutoFill Destination:=Sheets("DATA").Range(Cells(13, lColumn + 1), Cells(LastRow, lColumn + 1))
    Application.ScreenUpdating = True
End Sub

 

[mopo600]

Hi,

I'm using the code you gave me with some minor edits (file name, offset). I am getting a 400 error when I run it, but it will continue. The copy/paste of tabs works fine, but I can't get the new colum to work. It will add the new column heading, but will not autofill in the formula, the formula will only show up in one of the cell (random cell?) and not the whole column.

Also, can I add a pivottable using what was pasted in the DATA tab? I am not sure how to specify the range since it might change. I also need it to show FABRIC on rows, Division on columns, and sum of PROJECTION & ACTUAL on sum values. Is that possible?

Thanks again!


Sub CopyRange()
Application.ScreenUpdating = False
Dim LastRow As Long
Dim lColumn As Long
lColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Dim srcWb1 As Workbook
Set srcWb1 = Workbooks("FALL 18 WOMEN'S MASTER CHART.xlsx")
Dim srcWb2 As Workbook
Set srcWb2 = Workbooks("FALL 18 MEN'S MASTER CHART 1.xlsx")
Dim ws As Worksheet
For Each ws In srcWb1.Sheets(Array("RETAIL", "OUTLET", "SPECIAL SALES"))
ws.UsedRange.Offset(15, 0).Cells.Copy
Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next ws
For Each ws In srcWb2.Sheets(Array("RETAIL", "OUTLET", "SPECIAL SALES"))
ws.UsedRange.Offset(17, 0).Cells.Copy
Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Next ws
LastRow = Sheets("DATA").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lColumn = Sheets("DATA").Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("DATA").Cells(1, lColumn + 1) = "DIVISION"
Sheets("DATA").Cells(13, lColumn + 1).Formula = "=IF(OR(LEFT(d2,2)=""7W"",LEFT(d2,2)=""7Q""),""W"",IF(OR(LEFT(B2,2)=""7M"",LEFT(B2,2)=""7Y""),""M"",""""))"
Sheets("DATA").Cells(13, lColumn + 1).AutoFill Destination:=Sheets("DATA").Range(Cells(13, lColumn + 1), Cells(LastRow, lColumn + 1))
Application.ScreenUpdating = True
End Sub

 

[mumps]

It is always easier to help and test possible solutions if we could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

Also, when posting code, please use code tags. You can do this by selecting the code and pressing the # sign in the menu.

 

[mopo600]

Hi,


Thanks, sorry first time uploading code.

I've uploaded sample data to dropbox. Here are links for the 2 files
https://www.dropbox.com/s/k2ab2c1p9v1bp7h/FALL 17 MEN'S MASTER CHART.xlsx?dl=0
https://www.dropbox.com/s/nrc7e9wgapzhq5x/FALL 17 WOMEN'S MASTER CHART.xlsx?dl=0

https://www.dropbox.com/s/jww2mtmtjqvboly/Pivot.xlsx.xlsm?dl=0

3rd file is where I want the data dropped and pivoted from. Basically I need the data from all 6 tabs dropped in, the new column to specify whether its men'/women's and then to pivot the data with fabric on rows, division in columns and totals.


Thanks!

 

[mumps]

Here are the links to the 3 files:
https://app.box.com/s/1tfh0u38lmn5zin41tsqk3t41w258j5i
https://app.box.com/s/vje5wf50xgx2lteiko07v91njnhp198q
https://app.box.com/s/wvda0wvh208svy1ez0ix08jwlfzt5mvz
Please use these 3 files as I've had to make a few small changes to them. Unfortunately, I don't have much experience with pivot tables so the macro in Module 1 will not add the pivot table you requested.

 

[mopo600]

O that's much easier way to do it. Many thanks!!

 

[mumps]

You are very welcome.