Please amend this as per ur requirement...
On Fri, May 6, 2011 at 7:30 PM, rajan verma <rajanverma1...@gmail.com>wrote:
> HI Brajesh
> How are u... You can also Use this Macro By Compiling your All File...
>
>
> Sub Compile()
> On Error GoTo Err_Clear:
> Application.ScreenUpdating = False
> Application.DisplayAlerts = False
> Dim Fso As New Scripting.FileSystemObject
> Dim Path As String
>
> Application.FileDialog(msoFileDialogFolderPicker).Title = "Select Folder to
> Pick Downloaded Bills"
> Application.FileDialog(msoFileDialogFolderPicker).Show
> Path = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) &
> "\"
> If Path = "" Then Exit Sub
>
> Application.FileDialog(msoFileDialogFolderPicker).Title = "Select Folder to
> Save Compiled File"
> CompilePath = Application.FileDialog(msoFileDialogFolderPicker).Show
> compiledPath =
> Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
> If compiledPath = "" Then Exit Sub
>
>
> Dim Counter
> Dim File As File
> Dim Folder As Folder
> Dim wb As Workbook
> Dim ws As Worksheet
> Dim AcWb As Workbook
> Set AcWb = ActiveWorkbook
> ActiveWorkbook.Sheets.Add
> ActiveSheet.Name = "Index"
>
> Set Folder = Fso.GetFolder(Path)
>
> For Each File In Folder.Files
>
> If File.Type = "Microsoft Office Excel Binary Worksheet" Or
> File.Type = "Microsoft Office Excel Worksheet" And InStr(1, File.Name,
> "Download", vbTextCompare) Then
> Counter = Counter + 1
> Set wb = Workbooks.Open(Path & File.Name)
>
> If Application.Ready = True Then
>
> wb.Sheets("Index").Activate
> Call bulkUpload.GenerateReport
> ActiveSheet.UsedRange.Copy
> AcWb.Sheets("Index").Activate
> Range("A1000000").End(xlUp).Select
> ActiveSheet.Paste
> Application.CutCopyMode = False
> wb.Close
> End If
> End If
>
> Next
> If Counter > 0 Then
> AcWb.SaveAs compiledPath & "Compiled", xlExcel12
> AcWb.Close
> End If
> Err_Clear:
> Err.Clear
> Resume Next
>
> Application.DisplayAlerts = True
> Application.ScreenUpdating = True
> If Counter < 1 Then
> MsgBox "No File Found For Compile", vbInformation
> Else
> MsgBox Counter & " File Has been Compiled, Please Find your File
> at" & vbCrLf & compiledPath, vbInformation
> End If
>
> End Sub
>
>
>
>
> On Fri, May 6, 2011 at 7:26 PM, ashish koul <koul.ash...@gmail.com> wrote:
>
>> try this
>>
>> press alt +f11 goto tool -> reference -> Microsoft shell control and
>> automation and paste below code and run it.
>>
>> select the folder in which files 1 and 2 are stored
>>
>>
>> Function SelectFolder(Optional Title As String, Optional TopFolder _
>> As String) As String
>> Dim objShell As New Shell32.Shell
>> Dim objFolder As Shell32.Folder
>>
>> Set objFolder = objShell.BrowseForFolder _
>> (0, Title, 1, TopFolder)
>> If Not objFolder Is Nothing Then
>> SelectFolder = objFolder.Items.Item.Path
>> End If
>> End Function
>>
>>
>> Sub merge_sheets_from_workbooks_to_single()
>>
>> ' tool -> reference -> Microsoft shell control and automation
>> 'On Error GoTo gggg
>> Dim fldpth As String
>> Dim fld, fil As Object
>> Dim j, a As Long
>> Dim ask, ask2 As Workbook
>> Dim abc As Range
>> fldpth = SelectFolder("Select Folder", "")
>> Set fso = CreateObject("scripting.filesystemobject")
>>
>> Set fld = fso.getfolder(fldpth)
>>
>> Set ask = Workbooks.Add
>>
>> For Each fil In fld.Files
>>
>> If UCase(Right(fil.Path, 4)) = UCase(".xls") Or UCase(Right(fil.Path, 5))
>> = UCase(".xlsx") Then
>>
>> Set ask2 = Workbooks.Open(fil.Path)
>>
>> ask2.Activate
>> ask2.Sheets(1).Select
>> ask2.Sheets(1).Range("A1").Select
>>
>> ActiveCell.SpecialCells(xlLastCell).Select
>>
>> N = ActiveCell.Row - 1
>>
>> If N >= 2 Then
>>
>> Set abc = ask2.Sheets(1).Columns("a:A").Find("Page", LookIn:=xlValues)
>>
>>
>> Rows(abc.Row + 1 & ":" & N).Select
>> Selection.Copy
>>
>> ask.Activate
>>
>> ' change sheets(1) as per your requirement you can also write the name of
>> sheet for example if sheet name is abc then write sheets("abc")
>> ask.Sheets(1).Activate
>> Sheets(1).Range("A1").Select
>>
>> ActiveCell.SpecialCells(xlLastCell).Select
>>
>> Z = ActiveCell.Row + 1
>>
>>
>>
>> Range("A" & Z).Select
>> ActiveSheet.Paste
>> ask2.Activate
>> ask2.Close
>> End If
>> End If
>>
>> Next fil
>> ask.SaveAs ThisWorkbook.Path & "\" & "merge_data_file.xlsx"
>> 'gggg:
>> Exit Sub
>> End Sub
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>>
>> On Wed, May 4, 2011 at 3:16 PM, Brajesh Kumar Porwal <
>> brajeshkumarpor...@gmail.com> wrote:
>>
>>> hi expert,
>>>
>>> please help me.
>>>
>>> I want to compile all excel file by Macro.
>>> find enclose example data.
>>>
>>> Regards,
>>> Brajesh Kumar Porwal
>>> 9250525089,
>>>
>>> --
>>>
>>> ----------------------------------------------------------------------------------
>>> Some important links for excel users:
>>> 1. Follow us on TWITTER for tips tricks and links :
>>> http://twitter.com/exceldailytip
>>> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
>>> 3. Excel tutorials at http://www.excel-macros.blogspot.com
>>> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
>>> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>>>
>>> To post to this group, send email to excel-macros@googlegroups.com
>>>
>>> <><><><><><><><><><><><><><><><><><><><><><>
>>> Like our page on facebook , Just follow below link
>>> http://www.facebook.com/discussexcel
>>>
>>
>>
>>
>> --
>> *Regards*
>> * *
>> *Ashish Koul*
>> *akoul*.*blogspot*.com <http://akoul.blogspot.com/>
>> *akoul*.wordpress.com <http://akoul.wordpress.com/>
>> My Linkedin Profile <http://in.linkedin.com/pub/ashish-koul/10/400/830>
>>
>>
>> P Before printing, think about the environment.
>>
>>
>> --
>>
>> ----------------------------------------------------------------------------------
>> Some important links for excel users:
>> 1. Follow us on TWITTER for tips tricks and links :
>> http://twitter.com/exceldailytip
>> 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
>> 3. Excel tutorials at http://www.excel-macros.blogspot.com
>> 4. Learn VBA Macros at http://www.quickvba.blogspot.com
>> 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>>
>> To post to this group, send email to excel-macros@googlegroups.com
>>
>> <><><><><><><><><><><><><><><><><><><><><><>
>> Like our page on facebook , Just follow below link
>> http://www.facebook.com/discussexcel
>>
>
>
>
> --
> Regards
> Rajan verma
> +91 9158998701
>
--
Regards
Rajan verma
+91 9158998701
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
