Try the codes below
Public FileCounter As Long
Public FileNameArray
Public NewWorkbook As String
Public Sht As Worksheet
Sub main()
Dim i As Long
NewSheet
GetFileNames
For i = 1 To FileCounter
Workbooks.Open Filename:=FileNameArray(i)
NewWorkbook = ActiveWorkbook.Name
ProcessFile
Workbooks(NewWorkbook).Close SaveChanges:=False
MsgBox ("Click to continue")
Next
End Sub
Sub GetFileNames()
FileNameArray = Application.GetOpenFilename(, , , , True)
FileCounter = UBound(FileNameArray)
End Sub
Sub ProcessFile()
Dim DestRow As Long, RowCount As Long, i As Long
RowCount = ActiveSheet.Range("b1").CurrentRegion.Rows.Count
DestRow = Sht.Range("b" & Rows.Count).End(xlUp).Row + 1
If DestRow + RowCount > 65536 Then
MsgBox ("This sheet is full. New sheet will be added.")
NewSheet
DestRow = 1
End If
i = 1
For Each Sheet In Workbooks(NewWorkbook)
Workbooks(NewWorkbook).Sheets(i).Range
("b1").CurrentRegion.Copy _
Destination:=Sht.Cells(DestRow, 1)
Sht.Rows(DestRow).Delete shift:=xlUp
i = i + 1
End Sub
Sub NewSheet()
ThisWorkbook.Activate
ThisWorkbook.Sheets.Add
Set Sht = ActiveSheet
End Sub
On Jun 19, 2:19 pm, satish <satishpag...@gmail.com> wrote:
> Dear Friends,
> I have a hectic task of combining (copy pasting) data from 100s of excel
> file which is of same format. I tried one of the macros (mentioned below)
> that i found in internet. This macro is working for excel files with only
> one sheet in excel but the excel files i am trying to combine contains more
> than one sheet. So i need to combine all 1st sheets and 2nd sheet
> seperately. Please find the macro below and suggest the modification
> required or if anybody have ready macro, plz share with the group. I have
> also attached a sample file for your reference.
>
> Public FileCounter As Long
> Public FileNameArray
> Public NewWorkbook As String
> Public Sht As Worksheet
>
> Sub main()
> Dim i As Long
> NewSheet
> GetFileNames
> For i = 1 To FileCounter
> Workbooks.Open Filename:=FileNameArray(i)
> NewWorkbook = ActiveWorkbook.Name
> ProcessFile
> Workbooks(NewWorkbook).Close SaveChanges:=False
> MsgBox ("Click to continue")
> Next
> End Sub
>
> Sub GetFileNames()
> FileNameArray = Application.GetOpenFilename(, , , , True)
> FileCounter = UBound(FileNameArray)
> End Sub
>
> Sub ProcessFile()
> Dim DestRow As Long, RowCount As Long
>
> RowCount = ActiveSheet.Range("b1").CurrentRegion.Rows.Count
> DestRow = Sht.Range("b" & Rows.Count).End(xlUp).Row + 1
> If DestRow + RowCount > 65536 Then
> MsgBox ("This sheet is full. New sheet will be added.")
> NewSheet
> DestRow = 1
> End If
> Workbooks(NewWorkbook).Sheets(1).Range("b1").CurrentRegion.Copy
> Destination:=Sht.Cells(DestRow, 1)
> Sht.Rows(DestRow).Delete shift:=xlUp
> End Sub
>
> Sub NewSheet()
> ThisWorkbook.Activate
> ThisWorkbook.Sheets.Add
> Set Sht = ActiveSheet
> End Sub
>
> --
> Satish P N
> Asst. Manager
> South Indian Bank
>
> PULLAD-RETAIL.xls
> 93KViewDownload
--~--~---------~--~----~------------~-------~--~----~
-------------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---
