Re: $$Excel-Macros$$ Merge multiple Workbook

[Devendra Sahay]

Hi Sandeep,

I am sharing the code, If any group member can modify the code according to
you, would be helpful.

*** If we can assign few header names, of which data we want to extract
from the workbooks. It would be relevant. *


*Code *

Sub Merge_Files()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Long
Dim col_no As Long, row_no As Long
Dim arr_ws As Variant
Dim ws1 As Worksheet, wb1 As Workbook
Dim col_ws1 As Long, row_ws1 As Long

Set wb1 = ThisWorkbook
Set ws1 = ActiveSheet

Set d = Application.FileDialog(msoFileDialogFolderPicker)
d.Show
 fldpath = d.SelectedItems(1) & "\"

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(fldpath)
i = 0
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
Debug.Print objFile
i = i + 1
Workbooks.Open FileName:=objFile
row_no = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count,
1)).End(xlUp).Row
col_no = ActiveSheet.Range(Cells(1, Columns.Count), Cells(1,
Columns.Count)).End(xlToLeft).Column
arr_ws = ActiveSheet.Range(Cells(1, 1), Cells(row_no, col_no))
ActiveWorkbook.Close savechanges = no
ws1.Activate
If ws1.Range("A1").Value <> "" Then
row_ws1 = ActiveSheet.Range(Cells(Rows.Count, 1),
Cells(Rows.Count, 1)).End(xlUp).Row + 1
col_ws1 = ActiveSheet.Range(Cells(1, Columns.Count), Cells(1,
Columns.Count)).End(xlToLeft).Column
Else
row_ws1 = 1
col_ws1 = 1
End If
ws1.Range(Cells(row_ws1, 1), Cells(row_ws1 + row_no - 1, col_no)) =
arr_ws

Next objFile
End Sub





On Wed, Jan 27, 2016 at 2:19 PM, Sandeep Chhajer 
wrote:

> Hi Devendra,
>
> Thanks for your reply. The problem is the headers are not same in all the
> files. But some column headers are same in all the workbooks.
>
> So,  my requiremnt is a Macro which can search the column with that
> particular header name (common accross All the workbooks and paste it.
>
> Regards,
>
> Sandeep K Chhajer.
>
> Sent from my BlackBerry 10 smartphone.
> *From: *Devendra Sahay
> *Sent: *Wednesday 27 January 2016 10:59
> *To: *excel-macros@googlegroups.com
> *Reply To: *excel-macros@googlegroups.com
> *Subject: *Re: Fw: $$Excel-Macros$$ Merge multiple Workbook
>
> Hi Sandeep,
>
>
> I have a code, which simply goes to specific folder & open the workbooks
> one by one & copy the data and paste them in same sheet (Where the marcro
> is written).
>
> ** Make sure all the files have same header, because it copies all the
> data including the header.
>
> So if this is relevant, I can share the code.
>
> Thanks.
> Devendra
>
> On Tue, Jan 26, 2016 at 8:52 PM, Sandeep Chhajer  > wrote:
>
>> Hi,
>>
>>
>> Any way to solve this problem.
>>
>> Sent from my BlackBerry 10 smartphone.
>> *From: *Sandeep Chhajer 
>> *Sent: *Sunday 24 January 2016 18:07
>> *To: *Excel Macros
>> *Reply To: *excel-macros@googlegroups.com
>> *Subject: *$$Excel-Macros$$ Merge multiple Workbook
>>
>> Hi Excel guru,
>>
>> I have found macros for merging multiple workbook (kept in a single
>> folder) into a single worksheet.
>>
>> But my requirement is a step ahead...can that macro to be changed to copy
>> only specified column from every wrokbook (Sheet1). Like it will search in
>> all the workbooks (sheet1 row no 1 to 6 ) kept in a folder; and wherever it
>> will find "Name" , "Emp code"  or " Net payment" then copy the range into
>> new sheet one after one.
>>
>> the code I am using (got from website) for merging the workbooks are
>> pasted below. (Any thing new to solve the above problem is also welcome)
>>
>>
>> Sub simpleXlsMerger()
>> Dim bookList As Workbook
>> Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As
>> Object
>> Application.ScreenUpdating = False
>> Set mergeObj = CreateObject("Scripting.FileSystemObject")
>>
>> 'change folder path of excel files here
>> Set dirObj = mergeObj.Getfolder("C:WorkingMTMT 2015 16MT Q3Actuas All  ")
>> Set filesObj = dirObj.Files
>> For Each everyObj In filesObj
>> Set bookList = Workbooks.Open(everyObj)
>>
>> 'change "A2" with cell reference of start point for every files here
>> 'for example "B3:IV" to merge all files start from columns B and rows 3
>> 'If you're files using more than IV column, change it to the latest column
>> 'Also change "A" column on "A65536" to the same column as start point
>> Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
>> ThisWorkbook.Worksheets(1).Activate
>>
>> 'Do not change the following column. It's not the same column as above
>> Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
>> Application.CutCopyMode = False
>> bookList.Close
>> Next
>> End Sub
>>
>> Thanking you in advance.
>> --
>> Regards,
>> CA Sandeep Kumar Chhajer
>>
>> --
>> Are you =EXP(E:RT) or 

Re: $$Excel-Macros$$ Merge multiple Workbook

[Sandeep Chhajer]

  Hi Devendra, Thanks for your reply. The problem is the headers are not same in all the files. But some column headers are same in all the workbooks.So,  my requiremnt is a Macro which can search the column with that particular header name (common accross All the workbooks and paste it.Regards,Sandeep K Chhajer.     Sent from my BlackBerry 10 smartphone.From: Devendra SahaySent: Wednesday 27 January 2016 10:59To: excel-macros@googlegroups.comReply To: excel-macros@googlegroups.comSubject: Re: Fw: $$Excel-Macros$$ Merge multiple WorkbookHi Sandeep,I have a code, which simply goes to specific folder & open the workbooks one by one & copy the data and paste them in same sheet (Where the marcro is written).** Make sure all the files have same header, because it copies all the data including the header. So if this is relevant, I can share the code.Thanks.Devendra On Tue, Jan 26, 2016 at 8:52 PM, Sandeep Chhajer  wrote:  Hi,Any way to solve this problem.Sent from my BlackBerry 10 smartphone.From: Sandeep Chhajer Sent: Sunday 24 January 2016 18:07To: Excel MacrosReply To: excel-macros@googlegroups.comSubject: $$Excel-Macros$$ Merge multiple WorkbookHi Excel guru,I have found macros for merging multiple workbook (kept in a single folder) into a single worksheet.But my requirement is a step ahead...can that macro to be changed to copy only specified column from every wrokbook (Sheet1). Like it will search in all the workbooks (sheet1 row no 1 to 6 ) kept in a folder; and wherever it will find "Name" , "Emp code"  or " Net payment" then copy the range into new sheet one after one.the code I am using (got from website) for merging the workbooks are pasted below. (Any thing new to solve the above problem is also welcome)Sub simpleXlsMerger()Dim bookList As WorkbookDim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As ObjectApplication.ScreenUpdating = FalseSet mergeObj = CreateObject("Scripting.FileSystemObject") 'change folder path of excel files hereSet dirObj = mergeObj.Getfolder("C:WorkingMTMT 2015 16MT Q3Actuas All  ")Set filesObj = dirObj.FilesFor Each everyObj In filesObjSet bookList = Workbooks.Open(everyObj) 'change "A2" with cell reference of start point for every files here'for example "B3:IV" to merge all files start from columns B and rows 3'If you're files using more than IV column, change it to the latest column'Also change "A" column on "A65536" to the same column as start pointRange("A2:IV" & Range("A65536").End(xlUp).Row).CopyThisWorkbook.Worksheets(1).Activate 'Do not change the following column. It's not the same column as aboveRange("A65536").End(xlUp).Offset(1, 0).PasteSpecialApplication.CutCopyMode = FalsebookList.CloseNextEnd Sub      Thanking you in advance.-- Regards,CA Sandeep Kumar Chhajer




-- 
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s =TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @ https://www.facebook.com/discussexcel
 
FORUM RULES
 
1) Use concise, accurate thread titles. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
 
NOTE  : Don't ever post confidential data in a workbook. Forum owners and members are not responsible for any loss.
--- 
You received this message because you are subscribed to the Google Groups "MS EXCEL AND VBA MACROS" group.
To unsubscribe 

Re: $$Excel-Macros$$ Merge multiple Workbook

[Sandeep Chhajer]

  Thanks Devendra, I will send you some sample files for better understanding my requirements.Thanks again for your help.  Sent from my BlackBerry 10 smartphone.From: Devendra SahaySent: Wednesday 27 January 2016 15:32To: excel-macros@googlegroups.comReply To: excel-macros@googlegroups.comSubject: Re: $$Excel-Macros$$ Merge multiple WorkbookHi Sandeep,I am sharing the code, If any group member can modify the code according to you, would be helpful. ** If we can assign few header names, of which data we want to extract from the workbooks. It would be relevant. Code Sub Merge_Files()Dim objFSO As ObjectDim objFolder As ObjectDim objFile As ObjectDim i As LongDim col_no As Long, row_no As LongDim arr_ws As VariantDim ws1 As Worksheet, wb1 As WorkbookDim col_ws1 As Long, row_ws1 As LongSet wb1 = ThisWorkbookSet ws1 = ActiveSheetSet d = Application.FileDialog(msoFileDialogFolderPicker)d.Show fldpath = d.SelectedItems(1) & "\"'Create an instance of the FileSystemObjectSet objFSO = CreateObject("Scripting.FileSystemObject")'Get the folder objectSet objFolder = objFSO.GetFolder(fldpath)i = 0'loops through each file in the directory and prints their names and pathFor Each objFile In objFolder.FilesDebug.Print objFile    i = i + 1    Workbooks.Open FileName:=objFile    row_no = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row    col_no = ActiveSheet.Range(Cells(1, Columns.Count), Cells(1, Columns.Count)).End(xlToLeft).Column    arr_ws = ActiveSheet.Range(Cells(1, 1), Cells(row_no, col_no))    ActiveWorkbook.Close savechanges = no    ws1.Activate    If ws1.Range("A1").Value <> "" Then    row_ws1 = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row + 1    col_ws1 = ActiveSheet.Range(Cells(1, Columns.Count), Cells(1, Columns.Count)).End(xlToLeft).Column    Else    row_ws1 = 1    col_ws1 = 1    End If    ws1.Range(Cells(row_ws1, 1), Cells(row_ws1 + row_no - 1, col_no)) = arr_ws    Next objFileEnd SubOn Wed, Jan 27, 2016 at 2:19 PM, Sandeep Chhajer  wrote:  Hi Devendra, Thanks for your reply. The problem is the headers are not same in all the files. But some column headers are same in all the workbooks.So,  my requiremnt is a Macro which can search the column with that particular header name (common accross All the workbooks and paste it.Regards,



-- 
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s =TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @ https://www.facebook.com/discussexcel
 
FORUM RULES
 
1) Use concise, accurate thread titles. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
 
NOTE  : Don't ever post confidential data in a workbook. Forum owners and members are not responsible for any loss.
--- 
You received this message because you are subscribed to the Google Groups "MS EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.