try this it may help
Fpath = BrowseFolder(Caption:="Select the folder .")
excelFile = Dir(Fpath & "\*.xls")
Do While excelFile <> ""
If excelFile <> "Combined Manual Timesheets.xls" Then
Workbooks.Open Filename:=Fpath & "\" & excelFile
' copy rows
ActiveWorkbook.Sheets(1).Activate
LastRow = ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Rows("8:" & LastRow).EntireRow.Select
Selection.Copy
With Workbooks("Combined Manual Timesheets.xls")
.Sheets(1).Activate
LastRow = .Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
End With
With Workbooks("Combined Manual Timesheets.xls").Sheets(1).Range("A" &
(LastRow + 1))
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
ActiveWorkbook.Save
Workbooks(excelFile).Close
End If
Loop
On Thu, Jan 6, 2011 at 10:11 AM, Nasim <nbeiz...@gmail.com> wrote:
> Hi,
>
> I need to combine several excel files into one file. I create this new
> file in the directory that user chooses (this folder contains the
> files I want to copy). It loops trough the files and works perfectly
> except that it copies the "combined Manual Timesheets.xls" file and
> pastes it to itself (so the info is duplicated!)
> I get the folder from user in a function I found from net.
> how can I exclude this combined file from being copied?
>
> Thanks for your help in advance.
>
> Here is part of my code:
>
> Fpath = BrowseFolder(Caption:="Select the folder .")
> excelFile = Dir(Fpath & "\*.xls")
>
> ' I create the "Combined Manual Timesheets.xls" here
>
> Do While excelFile <> ""
>
> ' Do While excelFile <> "Combined Manual Timesheets.xls" or
> "" :This line did not work
>
> 'This IF does not work for some reason:
> If excelFile = "Combined Manual Timesheets.xls" Then
> Exit Do
> End If
>
>
> Workbooks.Open Filename:=Fpath & "\" & excelFile
>
> ' copy rows
> ActiveWorkbook.Sheets(1).Activate
> LastRow = ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
> ActiveSheet.Rows("8:" & LastRow).EntireRow.Select
> Selection.Copy
>
> With Workbooks("Combined Manual Timesheets.xls")
> .Sheets(1).Activate
> LastRow = .Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
> End With
>
> With Workbooks("Combined Manual
> Timesheets.xls").Sheets(1).Range("A" & (LastRow + 1))
> ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
> .PasteSpecial Paste:=8
> .PasteSpecial xlPasteValues
>
> End With
> Application.CutCopyMode = False
> ActiveWorkbook.Save
> Workbooks(excelFile).Close
>
> excelFile = Dir
> Loop
>
>
> Thanks,
>
> Nasim
>
>
> --
>
> ----------------------------------------------------------------------------------
> 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/pages/discussexcelcom/160307843985936?v=wall&ref=ts
>
--
*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/pages/discussexcelcom/160307843985936?v=wall&ref=ts
