combine excel workbooks into one sheet

instanceoftime

Board Regular
Joined
Mar 23, 2011
Messages
103
I have gotten previous help. Below is the code but It appears that it isn't copying the last row in each worksheet?

VBA Code:
Option Explicit
Public strPath As String
Public Type SELECTINFO
    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

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 SELECTINFO) As Long
Function SelectFolder(Optional Msg) As String
    Dim sInfo As SELECTINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
    sInfo.pidlRoot = 0&
    
    If IsMissing(Msg) Then
        sInfo.lpszTitle = "Select your folder."
    Else
        sInfo.lpszTitle = Msg
    End If
    
    sInfo.ulFlags = &H1
    
    x = SHBrowseForFolder(sInfo)
    
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        SelectFolder = Left(path, pos - 1)
    Else
        SelectFolder = ""
    End If
End Function
'Merge all your excel files to a main file.

[COLOR=rgb(184, 49, 47)]Sub MergeExcels()
    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 = 1 ' Row Number from where you wish to start copying
 
    ThisWB = ActiveWorkbook.Name
 
    path = SelectFolder("Select a folder containing Excel files you want to merge")
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.csv", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
            Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
            CopyRng.Copy Dest
            Wkb.Close False
        End If
 
        Filename = Dir()
    Loop
 
    Range("A1").Select
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 
    MsgBox "Files Merged!"
End Sub[/COLOR]
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Have you considered using Power Query to combine your workbooks?

 
Upvote 0
I'm a novice at this stuff. Using a macro to combine multiple inventory sheets into one sheet. LOL, I don't even know what a power query is but if it is something easy to explain please do (yes, reading link)
 
Upvote 0
Power Query is not available to you since it was launched with Excel 2010. I don't have an alternative answer for you. If you provide your Version of Excel into your profile, then we would know not to offer up that type of solution. Good Luck. I am sure others will chime in here soon.
 
Upvote 0
Hi,
Try

VBA Code:
IF shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row)=1 then
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row)
End if
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row+1)
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

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