Merge multiple files in a folder then save as 1 file. (getting error)

Slomaro2000

Board Regular
Joined
Jun 4, 2008
Messages
107
Hello,
Recently switched to Office 2007 and this is not working. Not sure if this is the best way for this macro to be written. So if there is a better way that would help.

What I need. Need to go into a specific folder and open merge all of the excel reports into 1 report (there might not be data in some cells so it will have to go off rows) saved as .csv into another specified folder.

Here is the code: I will highlight where it errors.
Code:
Option Explicit
Public strPath As String
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
                                     Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
                                   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
    '   Root folder = Desktop
    bInfo.pidlRoot = 0&
    '   Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
    End If
    '   Type of directory to return
    bInfo.ulFlags = &H1
    '   Display the dialog
    x = SHBrowseForFolder(bInfo)
    '   Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
'Description: Combines all files in a folder to a master file.
Sub MergeFiles()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
 
    RowofCopySheet = 2 ' Row to start on in the sheets you are copying from
 
    ThisWB = ActiveWorkbook.Name
 
  '  path = GetDirectory("Select a folder containing Excel files you want to merge")
    'path = "C:\Documents and Settings\u369875\Desktop\Project stuff\Testin Save_AS\Testing File Copy"
  path = "C:\Users\U369875\Desktop\Project stuff\Testin Save_AS\Macro sheets\Testing File Merge"
  
  
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
           [B][COLOR=red] Set CopyRng = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
[/COLOR][/B]            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
 
        Filename = Dir()
    Loop
 
    Range("A1").Select
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    
    
 
    MsgBox "Done!"
    
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\U369875\Desktop\Project stuff\Testin Save_AS\Macro sheets\Testing File Merge\Done\Ready for CSV Convert.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        
    ActiveWindow.Close
    
    
    
End Sub


Thanks
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Forum statistics

Threads
1,224,613
Messages
6,179,894
Members
452,948
Latest member
Dupuhini

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