0

The goal of this Macro is to combine data from multiple excel files from different months into one master excel file. I have created a tab for every month in the master excel file (see attached picture) that I would like the data to go to and stack on top of each other.

enter image description here

I found some helpful code that I got to work a few times but after modifications is now broken. A few issues that I think I need to resolve before it can work like I want are:

  1. This code is built with a fixed range that gets copied. The excel files I am looking at will have ranges that are variable.

  2. The code keeps breaking on the line that reads Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True). This could be because I am testing excel files in different month folders all that have the same name?

I am getting the following error: "Run-time error '1004': Microsoft Excel cannot access the file 'S:\Actg\TESTING\September\Loans_20180920.csv'. There are several possible reasons: -The file name or path does not exist. -The file is being used by another program". I went through and deleted all of the other excel files that I was testing except the ones in the September folder but I am still getting this error.

  1. Is there a way I can modify this code so that I don't have to copy it 12 times for every month? I was thinking it would be nice if a text box was prompted where I entered the month I wanted to download. Either way... I have already copied it 12 times so it wouldn't be any extra work.

Original Code Reference: Dan Wagner (Copying worksheets from multiple workbooks into current workbook)

Here's the code I am working with:

Sub Stack_Overflow_Example()

Dim MyFile As String, MyFiles As String, FilePath As String
Dim erow As Long

Dim wbMaster As Workbook, wbTemp As Workbook
Dim wsMaster As Worksheet, wsTemp As Worksheet

FilePath = "S:\Actg\TESTING\September\"
MyFiles = "S:\Actg\TESTING\September\*.csv"
MyFile = Dir(MyFiles)

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With


Set wbMaster = ThisWorkbook
Set wsMaster = wbMaster.Sheets("September")

Do While Len(MyFile) > 0

    If MyFile <> "master.xlsm" Then

        Set wbTemp = Workbooks.Open(Filename:=FilePath & MyFile, ReadOnly:=True)
        Set wsTemp = wbTemp.Sheets(1)

        With wsMaster

            erow = .Range("A" & .Rows.Count).End(xlUp).Row
            wsTemp.Range("A2:U88").Copy
            .Range("A" & erow).Offset(1, 0).PasteSpecial xlPasteValues

        End With

        wbTemp.Close False
        Set wsTemp = Nothing
        Set wbTemp = Nothing
    End If

    MyFile = Dir
Loop

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

Please let me know if you have additional questions.

braX
  • 11,506
  • 5
  • 20
  • 33
Brandon M.
  • 29
  • 9
  • Let's focus on issue 2 first, since the other two can be more easily managed. What error do you get when you try opening the workbook? – basodre Oct 19 '18 at 15:39
  • When you get the error you mention in point 2, press Debug and go back to the VB Editor and enter `Debug.Print FilePath & MyFile` followed by to see what it's attempting to open. – CLR Oct 19 '18 at 15:41
  • Hello I am getting the following error: "Run-time error '1004': Microsoft Excel cannot access the file 'S:\Actg\TESTING\September\Loans_20180920.csv'. There are several possible reasons: -The file name or path does not exist. -The file is being used by another program". I went through and deleted all of the other excel files that I was testing except the ones in the September folder but I am still getting this error. Thanks! – Brandon M. Oct 19 '18 at 16:45
  • @Brandon M. - FYI, it's usually better to [edit your question](https://stackoverflow.com/posts/52895421/edit) to add information instead of using comment. – cybernetic.nomad Oct 19 '18 at 16:51

1 Answers1

0

My scenario sounds a little different from yours, as each workbook I am copying data from has individual months in each of those workbooks as well as the master workbook, but this should get you on the right path.

Note that the code below assumes that there is a header row that should not be copied. If there is not then you will change the first row from 2 to 1 in the copy line. If you need to open files from multiple locations, you could add another loop for the number of locations before the file opening code block and have the MyFolder variable change for each location for each iteration of the loop.

Sub RefreshMasterWorkbookData()

'Enable Error Handling
On Error GoTo Oops

'Declare variables and objects
Dim WkBk As Workbook, WkShtMaster As Worksheet, WkShtUser As Worksheet, CopyToRow As Long, PasteAtRow As Long

'Turn off screen updating and calculation to improve process speed and turn off events to keep other code (such as Worksheet_Change) from being triggered
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Open all files in a given directory
Dim MyFolder As String, MyFile As String
MyFolder = "C:\MyFolder" 'OR: "\\NetworkServer\NetworkFolder"
MyFile = Dir(MyFolder & "\*.xlsm") '& "\*.xl*")
Do While MyFile <> ""
    Workbooks.Open FileName:=MyFolder & "\" & MyFile, ReadOnly:=True
    MyFile = Dir
Loop

For Each WkBk In Workbooks 'Loops through each open workbook
    If Not WkBk.Name = ThisWorkbook.Name Then 'If not this master workbook
        For Each WkShtUser In WkBk.Worksheets 'Loops through each worksheet in the current workbook
            Select Case WkShtUser.Name 'Worksheet name for Month
                Case "Jan" 'Jan is the worksheet name for the monthly tab/sheet in the users individual file
                    Set WkShtMaster = M_01 'M_01 is the CodeName of the monthly worksheet in Master file
                Case "Feb"
                    Set WkShtMaster = M_02
                Case "Mar"
                    Set WkShtMaster = M_03
                Case "Apr"
                    Set WkShtMaster = M_04
                Case "May"
                    Set WkShtMaster = M_05
                Case "Jun"
                    Set WkShtMaster = M_06
                Case "Jul"
                    Set WkShtMaster = M_07
                Case "Aug"
                    Set WkShtMaster = M_08
                Case "Sep"
                    Set WkShtMaster = M_09
                Case "Oct"
                    Set WkShtMaster = M_10
                Case "Nov"
                    Set WkShtMaster = M_11
                Case "Dec"
                    Set WkShtMaster = M_12
                Case Else
                    GoTo NextWkSht
            End Select

            PasteAtRow = WkShtMaster.Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row + 1 'find first empty row in master sheet for appropriate month

            With WkShtUser 'Clear autofilter, if on, and copy designated columns of data from row 2 through last row
                If .FilterMode = True Then .AutoFilterMode = False
                CopyToRow = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
                If CopyToRow = 1 Then GoTo EmptyWkSht
                .Range("A2", "Z" & CopyToRow).Copy 'Where "Z" is the lst column of data you want to copy
            End With
            WkShtMaster.Range("A" & PasteAtRow).PasteSpecial xlPasteValues 'Paste data to empty rows in master for appropriate month
EmptyWkSht:
            If Not WkShtMaster Is Nothing Then Set WkShtMaster = Nothing
            CopyToRow = 0
            PasteAtRow = 0
NextWkSht:
        Next
        WkBk.Saved = True
        WkBk.Close False
    End If
Next

Oops:
    If Err Then
        Debug.Print Err.Description
        MsgBox "Refresh Error:" & vbNewLine & vbNewLine & Err.Description, vbCritical, "Error..."
    Else
        MsgBox "Refresh Completed Successfully", vbInformation, "Refresh Complete..."
    End If

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Dustin
  • 25
  • 7