Excel VBA - Open another workbook and check if sheet exist and Merge

Question

I'm trying to get a solutions for the problem as stated in title. Let me explain it. I'm trying to merge multiple sheets by choosing a folder. I managed to achieve this by using the following 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

"Merging Part"
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 

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 & "\*.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)
        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 + 1)
        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

I even managed to tweak the above code to merge the second sheet of targeted workbook.

However in my new task i have to check the existence of "Data2" sheet. And if it is exist, i want to merge all those sheets into my current workbook.

Thanks.

You need to qualify all the ranges with the sheets. See how you did `Set copyRng = wkb.sheets(1).Range...`? You also need to add that part `wkb.Sheets(1)` before your use of `Cells()`, otherwise it's going to get that info from whatever the ActiveSheet is. — BruceWayne, Dec 19 '16 at 04:50
to check for the sheet, you can refer to this post http://stackoverflow.com/a/6838826/1651993 — nightcrawler23, Dec 19 '16 at 04:53
@BruceWayne yeap,, didn't realize that part. after edited, it is working. — MG78, Dec 20 '16 at 10:16

score 0 · Answer 1 · answered Dec 19 '16 at 09:36

Try this:

'Merging Part
Sub MergeExcels()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, wbSource As Workbook, shtDest As Worksheet, shtSource As Worksheet
Dim Filename As String
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer

RowofCopySheet = 1

ThisWB = ThisWorkbook.Name 'ActiveWorkbook.Name

path = SelectFolder("Select a folder containing Excel files you want to merge")

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ThisWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
        Set wbSource = Workbooks.Open(Filename:=path & "\" & Filename)
        For Each shtSource In wbSource.Worksheets ' loop through all worksheets
           If shtSource.Name = "Data2" Then 'if ther's a worksheet named "Data2"
                'Set CopyRng = shtSource.Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
                Set CopyRng = shtSource.UsedRange ' copy the used Range / Filled Range
                Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
                CopyRng.Copy Dest
           End If
        Next
        wbSource.Close False ' close the sourceworkbook
    End If
    Filename = Dir()
Loop

shtDest.Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Files Merged!"
End Sub

Excel VBA - Open another workbook and check if sheet exist and Merge

1 Answers1