Copying Data from Multiple Workbooks into Master

MalumMorale

New Member
Joined
May 28, 2019
Messages
6
Hey everyone,

this is my first post here since I'm new to VBA. I'm not good at coding but I will provide you with all the information I have right now.

Summary:

My goal --> Macro Step 2:
Trying to create a macro to consolidate data from multiple workbooks / Suppliers into one Master-File. This, first, Master-File edition will be used from a small amount of people to get data from their co-workers. They all will then give access to their master file to the same person, a new one . This person will use a new Master-File / Supermaster (Step 2) to consolidate the data from the original Master-Files. There's going to be another Step (3), which is basically going to be the same as in Step 2 but my current goal is to get to Step 2.

To clarify:
The data copied in Step1 is saved in the Suppliers Sheet2 ("Summen"), the copying starts at row 5 since there are headers in row 4. The macro for Step 1 is supposed to copy the supplier files data into Sheet1 ("AP-ProjektSumme"), starting at row 13 (12 is for headers).

What I did:
Access the new Master Sheet and change the copy range to Range(Cells(13, 1), Cells(lastRow, 17)).Copy

My problem:
When I edit and try to use the code from below for the requirements from Step 2 the copied data is messed up. What happens is that the data is copied correct until a specific column appears. The data then is shifted to the left and thereby not matching the header anymore. Which is kind of weird since the excel sheet itself has the same template structure. Also the headers are being copied and added to the last row copied even though it's not even in my specified copy range. I don't know if the copying itself or the pasting is the problem.
So what's happening doesn't make much sense to me... :confused:

The code attached is working for Step 1, but not Step 2 somehow.

Code for Step 1:

Code:
Private Sub copyDataMultipleWorkbooksIntoMaster()


'to change excels decimal separator from "," to "."
'converts numbers into the right format
With Application
    .DecimalSeparator = "."
    .UseSystemSeparators = False


End With


Dim folderPath As String, filePath As String, fileName As String


folderPath = "C:\Users\SXY\Desktop\Task\Programm\Cluster 1\Suppliers\"
'don't forget the backslash at the path end!


filePath = folderPath & "*.xls*"
    'xlsm, xlsx, xls* etc. files are copyable


fileName = Dir(filePath)


Dim lastRow As Long, lastColumn As Long


Do While fileName <> ""
Workbooks.Open (folderPath & fileName)


lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column


Worksheets("Summen").Activate


Range(Cells(5, 1), Cells(lastRow, 17)).Copy
    'Range(Cells(5, 1): 4th row is for headers, therefore start at row 5
    
    Application.DisplayAlerts = False
    'Optional: activate Notifications ("Your Clipboard has a large amount of data, would you like to paste that, yes or no?")
    
    ActiveWorkbook.Close
    
    emptyRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    'to find next emptyRow


ActiveSheet.Paste Destination:=Worksheets("AP-ProjektSumme").Range(Cells(emptyRow, 1), Cells(emptyRow, 17))
    'pasting the data into the master file


fileName = Dir


Loop


'reset system separator to ","
With Application
    .DecimalSeparator = ","
    .UseSystemSeparators = True
End With


End Sub

BTW pls ignore the system seperator change, it has nothing to do with the problem itself, just with the data I'm copying.

Please let me know if you need more information or have a another, better or easier approach for my task and problem! :)

I'll be looking forward for your responses since I've already read a few posts in this forum and I've seen that there are a lot of clever persons here! ;)

- Stephan
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
I did not see any reason for the behavior you described but I took the liberty of refining the code to a more readable strucfture. Give this a try and see if you still get the anomalies. Also, it is assumed that the code is being run from a standard code module like module1, so the "Private" keyword is not needed. That is only used in Sheets, ThisWorkbook and UserForm code modules.

Code:
Sub copyDataMultipleWorkbooksIntoMaster()
'to change excels decimal separator from "," to "."
'converts numbers into the right format
With Application
    .DecimalSeparator = "."
    .UseSystemSeparators = False
End With
Dim sh1 As Worksheet, sh2 As Worksheet, wb As Workbook
Set sh1 = Sheets("AP-ProjektSumme")
Dim folderPath As String, filePath As String, fileName As String
Dim lastRow As Long, lastColumn As Long
folderPath = "C:\Users\SXY\Desktop\Task\Programm\Cluster 1\Suppliers\" 'don't forget the backslash at the path end!
filePath = folderPath & "*.xls*"    'xlsm, xlsx, xls* etc. files are copyable
fileName = Dir(filePath)
    Do While fileName <> ""
        Set wb = Workbooks.Open(folderPath & fileName)
        sh2 = wb.Worksheets("Summen")
        lastRow = sh2.Cells(Rows.Count, 1).End(xlUp).Row
        lastColumn = sh2.Cells(1, Columns.Count).End(xlToLeft).Column
        sh2.Range(sh2.Cells(5, 1), sh2.Cells(lastRow, 17)).Copy sh1.Cells(Rows.Count, 1).End(xlUp)(2) 'copy/paste data
        'Range(Cells(5, 1): 4th row is for headers, therefore start at row 5
        wb.Close
        fileName = Dir
    Loop
'reset system separator to ","
With Application
    .DecimalSeparator = ","
    .UseSystemSeparators = True
End With
End Sub
 
Upvote 0
Hello JLGWhiz,

thank you for taking you time to read my question and trying to answer it. :)

You're right, my code needed more structure, thanks for the advice!

I just wanted to let you know that somehow I made my code work suddenly but I'm still not quite sure why it works now. The first thing I did was to set the filepath so that only .xlsm files can be copied, this way the macro only tried to copy from master.xlsm and not also master.xlsx (these master files were my new supplier after step1). Thereby it didn't copy the header into the lastrow of my new masterfile, lets just call it supermaster. I guess it the macro tried to find something to copy from master.xlsx but since all the data is contained in the .xlsm version it just copied the header instead of actual data. But this alone didn't do the job. Two of the columns in the masterfile I tried to copy were made smaller / set to a smaller width in excel (so that you can not see the data but you know there's a column). I extended their width so that I, the user, can see the data (I knew beforehand that there was data in it but it wasn't important to me what exactly was in there, only that it was copied as well). After that, it seems like the macro too found this one column in the middle of the data, which was not copied before. Since this columns data was then copied as well, the data copied matched the structure.

To me this doesn't make a lot of sense but it works for now and that's the only explanation I found for my problem. :confused:

Hope you have a nice day,
Stephan
 
Upvote 0
Glad you worked it out and thanks for the feedback.
Regards, JLG
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

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