• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

To consolidate selected sheets from multiple files into 1 file

Akshat Kumar

New Member
Hi All,
I am completely new to VBA. try to do my task using VBA codes available on internet.

Currently I am stuck up with a task of consolidating data from 15 files. Each of these 15 files have 4 sheets.
Say, the 4 sheets are named as "sh name1","sh name2", "sh name3", "sh name4".
I need to consolidate data from "sh name1" & "sh name2" only.

Data structure for "sh name1" is same for all the 15 files. Similarly the data structure is intact fir the remaining sheets as well.

Now, I am using below code to access 15 files stored in one folder. However it copies all the 4 sheets.

Code 1
Code:
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim sheet As Worksheet

Application.ScreenUpdating = False

FolderPath = "C:\user_abc\target_folder\"
Filename = Dir(FolderPath & "*.xls*")

Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
 
 For Each sheet In ActiveWorkbook.Sheets
 sheet.Copy After:=ThisWorkbook.Sheets(1)
 Next sheet
 
 Workbooks(Filename).Close
 Filename = Dir()
Loop

Application.ScreenUpdating = True
End Sub

I have edited the above For-Next loop to select my sheet as below. But it copies nothing.
Plz help.

Code 2

Code:
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim sheet As Worksheet

Dim sh As Worksheet
Dim wkbTarget As Workbook
Dim i, arrNames

Application.ScreenUpdating = False

FolderPath = "C:\user_abc\target_folder\"
Filename = Dir(FolderPath & "*.xls*")

Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
 
 Set wkbTarget = Workbooks.Add()
 arrNames = VBA.Array("sh name1","sh name2")
 For i = 0 To 1
  Set sh = Nothing
  On Error Resume Next
  Set sh = ThisWorkbook.Sheets(arrNames(i))
  On Error GoTo 0
  If Not sh Is Nothing Then
  sh.Copy After:=wkbTarget.Sheets(1)
  End If
 Next

 Workbooks(Filename).Close
 Filename = Dir()
Loop

Application.ScreenUpdating = True
End Sub
 
I'd recommend uploading sample workbook (at least 2 source and what the result should look like).

However, if you are fine with just importing sheets as is (no consolidation into single sheet)...

Try changing Do While... Loop part of code to something like....

Code:
Dim wb as Workbook
Do While Filename <> ""
    Set wb = Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
    For Each sheet In wb.Sheets
        If sheet.Name = "sh name1" Or sheet.Name = "sh name2" Then
            sheet.Copy After:=ThisWorkbook.Sheets(1)
        End If
    Next sheet
   
    wb.Close
    Filename = Dir()
Loop
 
Back
Top