**Resolved**Combining Multiple Excel Sheets

Ok here is the issue:

I have a macro that runs a report. It changes one cell in the report(which updates it to a new cost center) and then saves a hardcoded copy to a folder and leaves the workbook open. It does this for about thirty reports.

Now what I want is to do this....
I have folders for thirty people named "John Doe", "Sally Mae", etc.

After the macro has run the reports, and they are all open I want it to stick the appropriate file (which have names like 2431, 2541, 2786) in to the correct folder. Sometimes the file needs to go in to multiple people's folders.

Now here is the kicker, sometimes a manager wants multiple reports and wants them all combined into one workbook.

Any ideas?

-Thanks!!!!!!!

This should get you started. Note: you may want to disable screenupdating while this is running.
You will need a range in you controling workbook that contains the manager name as trh column header and a list of each report for that manger under the header.

VB Code:

Sub BuildMgrReport()
Const sPATH As String = "C:\data\gtg689a\" 'I used this path, but you will need to change it
 
Dim rngDistList As Range
Dim lMgrNum As Long
Dim wkbMgrReport As Workbook
Dim lReportNum As Long
Dim wkbSource As Workbook
 
    'Make sure we are in the correct directory
    ChDir sPATH
    
    'A range that stores the Manager Name in the first row
    'then the list of reports for that manager
    Set rngDistList = ThisWorkbook.Worksheets("Distributions").Range("Distribution_List")
    
    'Repeat the following for each manager
    For lMgrNum = 1 To rngDistList.Columns.Count
        
        'Creat a new workbook for the manager
        Set wkbMgrReport = Application.Workbooks.Add
        
        'Save that book in the current directory
        'Overwriting any existing file without a prompt
        Application.DisplayAlerts = False
        wkbMgrReport.SaveAs Filename:=rngDistList.Cells(1, lMgrNum).Value
        Application.DisplayAlerts = True
        
        'Now loop through each report for that manager
        For lReportNum = 2 To rngDistList.Rows.Count
            'only continue if there is a report name
            If rngDistList.Cells(lReportNum, lMgrNum).Value <> "" Then
                
                'open the report
                Set wkbSource = Application.Workbooks.Open(rngDistList.Cells(lReportNum, lMgrNum).Value)
                
                'copy the worksheet to the managers workbook
                wkbSource.Worksheets(1).Copy After:=wkbMgrReport.Worksheets(wkbMgrReport.Worksheets.Count)
                
                'close the report without saving
                wkbSource.Close False
            End If
        Next lReportNum
        
        'close the mangers report, saving the changes
        wkbMgrReport.Close True
    Next lMgrNum
    
    'Clear the object variables
    Set rngDistList = Nothing
    Set wkbMgrReport = Nothing
    Set wkbSource = Nothing
End Sub

Thanks man,

In the controlling workbook(the one that initially runs the reports), there is a cell that links to the macro and tells it where to stick all of the files. Can I do something like that for this so that every month i can just change a cell instead of going back in to the macro?

For example, this month, all the files got dumped into Feb F06, next month itll be March F06.

Sure
Just change sPATH to a variable in the procedure and populate it based on the value in your cell.

I am having trouble with setting the range of the distribution list. It crashes each time and highlights the line that sets the distribution list.

I changed the worksheet name to the correct one, and the range is also correct. But it keeps messing up. any ideas/

Can you post the code that you are using to set the range?
Also post the error message your are receiving.

Ok, I think the range is fine. I believe the problem is I'm not setting it to find the files correctly. When I run the macro, it tells me that it can not find the file "2517", which definitly exists in the directory that I want it to pull from. Here is the code:

VB Code:

Sub MISBuildMgrReport()
 
 
Dim rngDistList As Range
Dim lMgrNum As Long
Dim wkbMgrReport As Workbook
Dim lReportNum As Long
Dim wkbSource As Workbook
Dim sPATH As Variant
 
    
    'Set the path- this is the directory that all of the files are located
    Set sPATH = ThisWorkbook.Worksheets("MISDistrList").Range("B26")
    
    'Make sure we are in the correct directory
    ChDir sPATH
    
    'A range that stores the Manager Name in the first row
    'then the list of reports for that manager
    Set rngDistList = ThisWorkbook.Worksheets("MISDistrList").Range("A1:O19")
    
    'Repeat the following for each manager
    For lMgrNum = 1 To rngDistList.Columns.Count
        
        'Create a new workbook for the manager
        Set wkbMgrReport = Application.Workbooks.Add
        
        'Save that book in the current directory
        'Overwriting any existing file without a prompt
        Application.DisplayAlerts = False
        wkbMgrReport.SaveAs Filename:=rngDistList.Cells(1, lMgrNum).Value
        Application.DisplayAlerts = True
        
        'Now loop through each report for that manager
        For lReportNum = 2 To rngDistList.Rows.Count
          'only continue if there is a report name
            If rngDistList.Cells(lReportNum, lMgrNum).Value <> "" Then
                
              'open the report
                Set wkbSource = Application.Workbooks.Open(rngDistList.Cells(lReportNum, lMgrNum).Value)
                
             'copy the worksheet to the managers workbook
                wkbSource.Worksheets(1).Copy After:=wkbMgrReport.Worksheets(wkbMgrReport.Worksheets.Count)
                
             'close the report without saving
                wkbSource.Close False
            End If
        Next lReportNum
        
        'close the mangers report, saving the changes
        wkbMgrReport.Close True
    Next lMgrNum
    
    'Clear the object variables
    Set rngDistList = Nothing
    Set wkbMgrReport = Nothing
    Set wkbSource = Nothing
End Sub

What line are you getting the error on?

Also, please mark your code with the [Highlight=VB] tags - it makes it much easier to read...

VB Code:

'open the report
                Set wkbSource = Application.Workbooks.Open(rngDistList.Cells(lReportNum, lMgrNum).Value)

OK, I need you to re-run the code and debug when it throws the error. At that point you will need to determine what the values of lReportNum and lMgrNum are. (Hover your cursor over the variable in the code and it will pop-up)
Then, find the value in the coresponding cell in the rngDistList range and post that value here.

Also, to tag your code you need to put vbcode (in the square brackets) before it and /vbcode (in the square brackets) after it. If you click on the go Advanced button you can also select a section of your reply and then click on the VBCode button above to wrap your code in the tags. ;)

Ok the values are:
1 report num= 2
1 Mgr Num = 1
The value in the rng distr list is "2517"

Thanks for your help, and I think I got the [Highlight=VB] thing working.

I tried that filename and it works, so the problem must be with the directory structure.

Are all the individual reports in the same directory?

What is the fully qualified path to this directory?

What is the value in "Worksheets("MISDistrList").Range("B26")"? I.e. what is the value of the sPATH variable?

Yes, they are all in the directory below.

The full path is:
G:\BPFA\F06\Closing Process\Monthly Reporting\Cost Center Reporting\February F06\MIS

The value in B26 is:
G:\BPFA\F06\Closing Process\Monthly Reporting\Cost Center Reporting\February F06\MIS

This might be a long shot but, try replacing

VB Code:

Set wkbSource = Application.Workbooks.Open(rngDistList.Cells(lReportNum, lMgrNum).[B]Value[/B])

with

VB Code:

Set wkbSource = Application.Workbooks.Open(rngDistList.Cells(lReportNum, lMgrNum).[B]Text[/B])

I'm just going to post the actual file, if you don't have any ideas, I appreciate all of the help you have given me.

If you get a second to look at it, I am stumped to say the least.

I fixed it a lot of the problem. In order for it to find the correct file, I changed the reports listed under each manager name from simply "2517" to "G:\BPFA\Filepath.....2517.xls. So now the macro runs, and it grabs all of the correct files, the only problem is that it does not save them in the correct directory, it saves them to My Documents.

OK I'm an idiot.
The problem is that you are trying to change the directory without first changing the drive to "G". ChDir only works within a drive. You will need to change to the G: drive before moving to the file path.

replace

VB Code:

ChDir sPATH

with

VB Code:

ChDrive "G"
ChDir sPATH

That, I hope, should do it.

Also, with this change you will not need the full path in the report list, only the file name.

Thank you so much!! That really is beautiful.
I added this to the code to delete sheets 1-3 that are not overwritten when the new workbook is opened.

VB Code:

'Delete sheets 1,2,and 3 on the new reports
         Sheets("Sheet1").Select
         ActiveWindow.SelectedSheets.Delete
         Sheets("Sheet2").Select
         ActiveWindow.SelectedSheets.Delete
         Sheets("Sheet3").Select
         ActiveWindow.SelectedSheets.Delete
        'close the mangers report, saving the changes
        wkbMgrReport.Close True

It runs well, the only problem is this warning message pops up:
Data may exist in the sheets selected for deletion. To permanantly delete the data, press delete

Is there any way to prevent that?

Yes you can disable alerts before you delete the sheet and re-enable it when you are done.

Rather than selecting each sheet before you delete it, you can just loop through the sheets to be deleted. The Excel application object has a property called SheetsInNewWorkbook that is useful here.

You should insert the following into the procedure just before you close "wkbMgrReport". You will need to declare lSheetNum as a 'Long' variable type.

VB Code:

'turn off user messaging
    Application.DisplayAlerts = False
    
    'Remove the default number of sheet
    For lSheetNum = Application.SheetsInNewWorkbook To 1 Step -1
        wkbMgrReport.Worksheets(lSheetNum).Delete
    Next lSheetNum
    
    'turn user messaging back on
    Application.DisplayAlerts = True