burley
06-04-2009, 03:03 PM
Hi,
I want to copy a range from Sheet1!A6 to Sheet1!Z100 from multiple files into one excel workbook called Holiday. Ideally the code only needs to copy any row with numbers in it, as often only rows down to about 20 are have information in. There could be anywhere from 1 to 26 files that I want to copy this range from. The information can be just pasted on sheet one of the Holiday workbook and each file it copies in will just paste below the last on copied.
I hope that makes some sort of sense...
Now looking around, I found some code that almost works, but for some reason it does not always copy the same range into the Holiday file. It seems to do the first workbook fine, but then starts to copy row A4 to Z4 instead, which isn't in the initial range, and it seems to ignor rows with information in?
Sorry if this is long winded, and i'm more than happy to forget this code if there is a better way.
Thank you so much
Sub FindAndAppendFiles()
Dim fs As FileSearch
Dim NewWB As Workbook
Set fs = Application.FileSearch
With fs
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
End With
With fs
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If Not .FoundFiles(i) Like "*Holiday.xls" Then
Set NewWB = Workbooks.Open(.FoundFiles(i), Password:="password")
NewWB.Sheets(1).Range(NewWB.Sheets(1).Range("A6"), NewWB.Sheets(1).Range("z100").End(xlUp)).Copy
ThisWorkbook.Sheets(1).Range("A60000").End(xlUp).Offset(1).PasteSpecial xlValues
NewWB.Close False
End If
Next
End If
End With
End Sub
I want to copy a range from Sheet1!A6 to Sheet1!Z100 from multiple files into one excel workbook called Holiday. Ideally the code only needs to copy any row with numbers in it, as often only rows down to about 20 are have information in. There could be anywhere from 1 to 26 files that I want to copy this range from. The information can be just pasted on sheet one of the Holiday workbook and each file it copies in will just paste below the last on copied.
I hope that makes some sort of sense...
Now looking around, I found some code that almost works, but for some reason it does not always copy the same range into the Holiday file. It seems to do the first workbook fine, but then starts to copy row A4 to Z4 instead, which isn't in the initial range, and it seems to ignor rows with information in?
Sorry if this is long winded, and i'm more than happy to forget this code if there is a better way.
Thank you so much
Sub FindAndAppendFiles()
Dim fs As FileSearch
Dim NewWB As Workbook
Set fs = Application.FileSearch
With fs
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
End With
With fs
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If Not .FoundFiles(i) Like "*Holiday.xls" Then
Set NewWB = Workbooks.Open(.FoundFiles(i), Password:="password")
NewWB.Sheets(1).Range(NewWB.Sheets(1).Range("A6"), NewWB.Sheets(1).Range("z100").End(xlUp)).Copy
ThisWorkbook.Sheets(1).Range("A60000").End(xlUp).Offset(1).PasteSpecial xlValues
NewWB.Close False
End If
Next
End If
End With
End Sub