Combine only first sheets of multiple workbooks to one workbook

Aktist

New Member
Joined
Aug 8, 2014
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hello,
I learned a lot from this forum, it helped me almost every time I needed something. But now I came to a wall, which I can't crush. I found a lot of threads to this problem, but didn't get the result I wanted.
I have a workbook for each month, every workbook contains data of errors from the production. I have to combine this data from each month into one workbook on one sheet. The data starts at A11 and ends at AB with different numbers of lines in each workbook (ex. A11:AB342, A11:AB186,...).

I found a nice code from the Microsoft page but I think the problem is that my workbooks contain more than one sheet. Each workbook contains 18 sheets, but the data I need is stored only on one sheet named MFO1 (every workbook has the same names of the sheets).

Code:
Sub test()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\ka72skl\Desktop\Test"
    
    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1
    
    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    FileName = Dir(FolderPath & "*.xlsx*")
    
    ' Loop until Dir returns an empty string.
    Do While FileName <> ""
        ' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FolderPath & FileName)
        
        ' Set the cell in column A to be the file name.
        SummarySheet.Range("A" & NRow).Value = FileName
        
        ' Set the source range to be A9 through C9.
        ' Modify this range for your workbooks.
        ' It can span multiple rows.
        Dim LastRow As Long
    LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
                 After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
                 SearchDirection:=xlPrevious, _
                 LookIn:=xlFormulas, _
                 SearchOrder:=xlByRows).Row
    Set SourceRange = WorkBk.Worksheets(1).Range("A11:AB" & LastRow)

        
        ' Set the destination range to start at column B and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count
        
        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
        
        ' Use Dir to get the next file name.
        FileName = Dir()
    Loop
    
    ' Call AutoFit on the destination sheet so that all
    ' data is readable.
    SummarySheet.Columns.AutoFit
End Sub

Maybe this code needs just some adjustments to do the job done?

Thanks to all who will try to get the code working properly.:)
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Hello Aktist
If your MFO1 sheet is not always sheet(1) then try the following - Untested - mod
Code:
Sub Aktist()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim WrkSht As Worksheet
    Dim SourceRange As Range
    Dim DestRange As Range
    
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\ka72skl\Desktop\Test"
    
    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1
    
    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    FileName = Dir(FolderPath & "*.xlsx*")
    
    ' Loop until Dir returns an empty string.
    Do While FileName <> ""
        ' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FolderPath & FileName)
        Set WrkSht = WorkBk.Sheets("MFO1")
        
        ' Set the cell in column A to be the file name.
        SummarySheet.Range("A" & NRow).Value = FileName
        
        ' Set the source range to be A9 through C9.
        ' Modify this range for your workbooks.
        ' It can span multiple rows.
        Dim LastRow As Long
    LastRow = WrkSht.Cells.Find(What:="*", _
                 After:=WrkSht.Cells.Range("A1"), _
                 SearchDirection:=xlPrevious, _
                 LookIn:=xlFormulas, _
                 SearchOrder:=xlByRows).Row
    Set SourceRange = WrkSht.Range("A11:AB" & LastRow)

        
        ' Set the destination range to start at column B and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
           
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
        
        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count
        
        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
        
        ' Use Dir to get the next file name.
        FileName = Dir()
    Loop
    
    ' Call AutoFit on the destination sheet so that all
    ' data is readable.
    SummarySheet.Columns.AutoFit
End Sub
Otherwise please explain why the code doesn't work/do what you want.
Cheers
 
Upvote 0
Hi,
Thanks for the response.

MFO1 sheet is always the first sheet. All the workbooks are the same, just with different data and names (by month).
The problem at my first code was that it only opened a new workbook without getting the data. It's still the same with yours/fixed code. :confused: At first I taught there was the problem with too many sheets, now I have no clue. There are no errors.

2iqiw6d.png


Best regards
 
Upvote 0
it only opened a new workbook without getting the data
This sounds as though it can't find any files to open. 2 thinks to check
1) Make absolutely sure that the FolderPath is correct
2) Do all your files end in .xlsx?
 
Upvote 0
This sounds as though it can't find any files to open. 2 thinks to check
1) Make absolutely sure that the FolderPath is correct
2) Do all your files end in .xlsx?

Yes, I checked both and as you can see there shouldn't be a problem with the connections.

FolderPath = "C:\Users\ka72skl\Desktop\Test"
2yysh92.png


FileName = Dir(FolderPath & "*.xlsx*")
4gg9ll.png
</pre>
 
Upvote 0
Missed it before, but the path has to end with a "\" ie
Code:
FolderPath = "C:\Users\ka72skl\Desktop\Test\"
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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