Copy same range of data from all workbooks and paste into consolid

[JEFF]

Hi All,

I'd like to be able to go to each workbook in a folder and copy the same
data range from each and paste into a consolidated workbook. For example, go
to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
paste into Consolidated.xls..... This implies that the contents copied from
workbook A would go into row 1, the contents from workbook B would go into
row 2, and so on....

Any help would be greatly appreciated!

[Macgru]

U¿ytkownik "JEFF" <JEFF@discussions.microsoft.com> napisa³ w wiadomo¶ci
news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> Hi All,
>
> I'd like to be able to go to each workbook in a folder and copy the same
> data range from each and paste into a consolidated workbook. For example,
go
> to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3),
and
> paste into Consolidated.xls..... This implies that the contents copied
from
> workbook A would go into row 1, the contents from workbook B would go into
> row 2, and so on....
>
> Any help would be greatly appreciated!


try this site
http://www.rondebruin.nl/summary2.htm
mcg

[Doug Glancy]

Jeff,

Take a look here:

http://www.rondebruin.nl/copy3.htm

hth,

Doug

"JEFF" <JEFF@discussions.microsoft.com> wrote in message
news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> Hi All,
>
> I'd like to be able to go to each workbook in a folder and copy the same
> data range from each and paste into a consolidated workbook. For example,
go
> to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3),
and
> paste into Consolidated.xls..... This implies that the contents copied
from
> workbook A would go into row 1, the contents from workbook B would go into
> row 2, and so on....
>
> Any help would be greatly appreciated!
>

[Ron de Bruin]

I have a example on my site Jeff
http://www.rondebruin.nl/copy3.htm

Or with formulas
http://www.rondebruin.nl/summary2.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl



"JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> Hi All,
>
> I'd like to be able to go to each workbook in a folder and copy the same
> data range from each and paste into a consolidated workbook. For example, go
> to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
> paste into Consolidated.xls..... This implies that the contents copied from
> workbook A would go into row 1, the contents from workbook B would go into
> row 2, and so on....
>
> Any help would be greatly appreciated!

[JEFF]

Success! Thanks

"Ron de Bruin" wrote:

> I have a example on my site Jeff
> http://www.rondebruin.nl/copy3.htm
>
> Or with formulas
> http://www.rondebruin.nl/summary2.htm
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
>
> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> > Hi All,
> >
> > I'd like to be able to go to each workbook in a folder and copy the same
> > data range from each and paste into a consolidated workbook. For example, go
> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
> > paste into Consolidated.xls..... This implies that the contents copied from
> > workbook A would go into row 1, the contents from workbook B would go into
> > row 2, and so on....
> >
> > Any help would be greatly appreciated!
>
>
>

[JEFF]

Thanks again..... Just to push my luck: What if I wanted to copy every 50th
row (starting at row 100) and bring it back to the consolidating workbook?
This would require varying number of rows being copied as the size of the
source workbooks differ.........

Any hope?




"Ron de Bruin" wrote:

> I have a example on my site Jeff
> http://www.rondebruin.nl/copy3.htm
>
> Or with formulas
> http://www.rondebruin.nl/summary2.htm
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
>
> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> > Hi All,
> >
> > I'd like to be able to go to each workbook in a folder and copy the same
> > data range from each and paste into a consolidated workbook. For example, go
> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
> > paste into Consolidated.xls..... This implies that the contents copied from
> > workbook A would go into row 1, the contents from workbook B would go into
> > row 2, and so on....
> >
> > Any help would be greatly appreciated!
>
>
>

[Ron de Bruin]

Hi Jeff

I must go now but will give you a example this evening or tomorrow

--
Regards Ron de Bruin
http://www.rondebruin.nl



"JEFF" <JEFF@discussions.microsoft.com> wrote in message news:C38D25A9-C3C5-4FD2-9502-5B0262ED1259@microsoft.com...
> Thanks again..... Just to push my luck: What if I wanted to copy every 50th
> row (starting at row 100) and bring it back to the consolidating workbook?
> This would require varying number of rows being copied as the size of the
> source workbooks differ.........
>
> Any hope?
>
>
>
>
> "Ron de Bruin" wrote:
>
>> I have a example on my site Jeff
>> http://www.rondebruin.nl/copy3.htm
>>
>> Or with formulas
>> http://www.rondebruin.nl/summary2.htm
>>
>>
>> --
>> Regards Ron de Bruin
>> http://www.rondebruin.nl
>>
>>
>>
>> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
>> > Hi All,
>> >
>> > I'd like to be able to go to each workbook in a folder and copy the same
>> > data range from each and paste into a consolidated workbook. For example, go
>> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
>> > paste into Consolidated.xls..... This implies that the contents copied from
>> > workbook A would go into row 1, the contents from workbook B would go into
>> > row 2, and so on....
>> >
>> > Any help would be greatly appreciated!
>>
>>
>>

[Ron de Bruin]

Hi Jeff

Here is a basic example
Copy both (macro and function in a normal module)
Post back if you have problems

Sub TestFile1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rw As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A").Value = mybook.Name
' This will add the workbook name in column A if you want

For rw = 100 To LastRow(mybook.Sheets(1)) Step 50
Set sourceRange = mybook.Worksheets(1).Rows(rw)
Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
sourceRange.Copy destrange
Next

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Ron de Bruin" <rondebruin@kabelfoon.nl> wrote in message news:%23cBP57dQFHA.508@TK2MSFTNGP12.phx.gbl...
> Hi Jeff
>
> I must go now but will give you a example this evening or tomorrow
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
>
> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:C38D25A9-C3C5-4FD2-9502-5B0262ED1259@microsoft.com...
>> Thanks again..... Just to push my luck: What if I wanted to copy every 50th
>> row (starting at row 100) and bring it back to the consolidating workbook?
>> This would require varying number of rows being copied as the size of the
>> source workbooks differ.........
>>
>> Any hope?
>>
>>
>>
>>
>> "Ron de Bruin" wrote:
>>
>>> I have a example on my site Jeff
>>> http://www.rondebruin.nl/copy3.htm
>>>
>>> Or with formulas
>>> http://www.rondebruin.nl/summary2.htm
>>>
>>>
>>> --
>>> Regards Ron de Bruin
>>> http://www.rondebruin.nl
>>>
>>>
>>>
>>> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
>>> > Hi All,
>>> >
>>> > I'd like to be able to go to each workbook in a folder and copy the same
>>> > data range from each and paste into a consolidated workbook. For example, go
>>> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
>>> > paste into Consolidated.xls..... This implies that the contents copied from
>>> > workbook A would go into row 1, the contents from workbook B would go into
>>> > row 2, and so on....
>>> >
>>> > Any help would be greatly appreciated!
>>>
>>>
>>>
>
>

[JEFF]

Genius...... One thing: As I customized it for my needs, I now have it
returning the file name in a row above the associated data. Couldn't quite
figure out how to have the file name be in the same row as the first line of
data retrieved from that file.....

Thanks!



Sub Every_Nth_Row()


Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rw As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "Y:\Sales\Target Customer\2005 Mainframe Download - Main"

ChDrive MyPath
ChDir MyPath
FNames = Dir("CO*RG***-0*M.xls")

If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)


' This will add the workbook name in column A if you want
basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1,
"A").Value = mybook.Name



'***************** START ROW ---- STEP NUMBER OF ROWS
*******************************

For rw = 1337 To LastRow(mybook.Sheets(1)) Step 61
Set sourceRange = mybook.Worksheets(1).Rows(rw)
Set destrange =
basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
sourceRange.Copy destrange
Next

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function






"Ron de Bruin" wrote:

> Hi Jeff
>
> Here is a basic example
> Copy both (macro and function in a normal module)
> Post back if you have problems
>
> Sub TestFile1()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim sourceRange As Range
> Dim destrange As Range
> Dim rw As Long
> Dim SourceRcount As Long
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = CurDir
> MyPath = "C:\Data"
> ChDrive MyPath
> ChDir MyPath
> FNames = Dir("*.xls")
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
> basebook.Worksheets(1).Cells.Clear
> 'clear all cells on the first sheet
>
> Do While FNames <> ""
> Set mybook = Workbooks.Open(FNames)
> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A").Value = mybook.Name
> ' This will add the workbook name in column A if you want
>
> For rw = 100 To LastRow(mybook.Sheets(1)) Step 50
> Set sourceRange = mybook.Worksheets(1).Rows(rw)
> Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> sourceRange.Copy destrange
> Next
>
> mybook.Close False
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
> Function LastRow(sh As Worksheet)
> On Error Resume Next
> LastRow = sh.Cells.Find(What:="*", _
> After:=sh.Range("A1"), _
> Lookat:=xlPart, _
> LookIn:=xlFormulas, _
> SearchOrder:=xlByRows, _
> SearchDirection:=xlPrevious, _
> MatchCase:=False).Row
> On Error GoTo 0
> End Function
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
>
> "Ron de Bruin" <rondebruin@kabelfoon.nl> wrote in message news:%23cBP57dQFHA.508@TK2MSFTNGP12.phx.gbl...
> > Hi Jeff
> >
> > I must go now but will give you a example this evening or tomorrow
> >
> > --
> > Regards Ron de Bruin
> > http://www.rondebruin.nl
> >
> >
> >
> > "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:C38D25A9-C3C5-4FD2-9502-5B0262ED1259@microsoft.com...
> >> Thanks again..... Just to push my luck: What if I wanted to copy every 50th
> >> row (starting at row 100) and bring it back to the consolidating workbook?
> >> This would require varying number of rows being copied as the size of the
> >> source workbooks differ.........
> >>
> >> Any hope?
> >>
> >>
> >>
> >>
> >> "Ron de Bruin" wrote:
> >>
> >>> I have a example on my site Jeff
> >>> http://www.rondebruin.nl/copy3.htm
> >>>
> >>> Or with formulas
> >>> http://www.rondebruin.nl/summary2.htm
> >>>
> >>>
> >>> --
> >>> Regards Ron de Bruin
> >>> http://www.rondebruin.nl
> >>>
> >>>
> >>>
> >>> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> >>> > Hi All,
> >>> >
> >>> > I'd like to be able to go to each workbook in a folder and copy the same
> >>> > data range from each and paste into a consolidated workbook. For example, go
> >>> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
> >>> > paste into Consolidated.xls..... This implies that the contents copied from
> >>> > workbook A would go into row 1, the contents from workbook B would go into
> >>> > row 2, and so on....
> >>> >
> >>> > Any help would be greatly appreciated!
> >>>
> >>>
> >>>
> >
> >
>
>
>

[Ron de Bruin]

Try this to insert the file name in A

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
For rw = 75 To LastRow(mybook.Sheets(1)) Step 50
Set sourceRange = mybook.Worksheets(1).Rows(rw)
Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
sourceRange.Copy destrange
If rw = 75 Then
basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)), "A").Value = mybook.Name
End If
Next
mybook.Close False
FNames = Dir()
Loop


--
Regards Ron de Bruin
http://www.rondebruin.nl



"JEFF" <JEFF@discussions.microsoft.com> wrote in message news:6D46C700-B629-4BD3-A8E5-9A99F1ADBF82@microsoft.com...
> Genius...... One thing: As I customized it for my needs, I now have it
> returning the file name in a row above the associated data. Couldn't quite
> figure out how to have the file name be in the same row as the first line of
> data retrieved from that file.....
>
> Thanks!
>
>
>
> Sub Every_Nth_Row()
>
>
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim sourceRange As Range
> Dim destrange As Range
> Dim rw As Long
> Dim SourceRcount As Long
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = CurDir
> MyPath = "Y:\Sales\Target Customer\2005 Mainframe Download - Main"
>
> ChDrive MyPath
> ChDir MyPath
> FNames = Dir("CO*RG***-0*M.xls")
>
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
> basebook.Worksheets(1).Cells.Clear
> 'clear all cells on the first sheet
>
> Do While FNames <> ""
> Set mybook = Workbooks.Open(FNames)
>
>
> ' This will add the workbook name in column A if you want
> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1,
> "A").Value = mybook.Name
>
>
>
> '***************** START ROW ---- STEP NUMBER OF ROWS
> *******************************
>
> For rw = 1337 To LastRow(mybook.Sheets(1)) Step 61
> Set sourceRange = mybook.Worksheets(1).Rows(rw)
> Set destrange =
> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> sourceRange.Copy destrange
> Next
>
> mybook.Close False
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
> Function LastRow(sh As Worksheet)
> On Error Resume Next
> LastRow = sh.Cells.Find(What:="*", _
> After:=sh.Range("A1"), _
> Lookat:=xlPart, _
> LookIn:=xlFormulas, _
> SearchOrder:=xlByRows, _
> SearchDirection:=xlPrevious, _
> MatchCase:=False).Row
> On Error GoTo 0
> End Function
>
>
>
>
>
>
> "Ron de Bruin" wrote:
>
>> Hi Jeff
>>
>> Here is a basic example
>> Copy both (macro and function in a normal module)
>> Post back if you have problems
>>
>> Sub TestFile1()
>> Dim basebook As Workbook
>> Dim mybook As Workbook
>> Dim sourceRange As Range
>> Dim destrange As Range
>> Dim rw As Long
>> Dim SourceRcount As Long
>> Dim FNames As String
>> Dim MyPath As String
>> Dim SaveDriveDir As String
>>
>> SaveDriveDir = CurDir
>> MyPath = "C:\Data"
>> ChDrive MyPath
>> ChDir MyPath
>> FNames = Dir("*.xls")
>> If Len(FNames) = 0 Then
>> MsgBox "No files in the Directory"
>> ChDrive SaveDriveDir
>> ChDir SaveDriveDir
>> Exit Sub
>> End If
>>
>> Application.ScreenUpdating = False
>> Set basebook = ThisWorkbook
>> basebook.Worksheets(1).Cells.Clear
>> 'clear all cells on the first sheet
>>
>> Do While FNames <> ""
>> Set mybook = Workbooks.Open(FNames)
>> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A").Value = mybook.Name
>> ' This will add the workbook name in column A if you want
>>
>> For rw = 100 To LastRow(mybook.Sheets(1)) Step 50
>> Set sourceRange = mybook.Worksheets(1).Rows(rw)
>> Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
>> sourceRange.Copy destrange
>> Next
>>
>> mybook.Close False
>> FNames = Dir()
>> Loop
>> ChDrive SaveDriveDir
>> ChDir SaveDriveDir
>> Application.ScreenUpdating = True
>> End Sub
>>
>> Function LastRow(sh As Worksheet)
>> On Error Resume Next
>> LastRow = sh.Cells.Find(What:="*", _
>> After:=sh.Range("A1"), _
>> Lookat:=xlPart, _
>> LookIn:=xlFormulas, _
>> SearchOrder:=xlByRows, _
>> SearchDirection:=xlPrevious, _
>> MatchCase:=False).Row
>> On Error GoTo 0
>> End Function
>>
>>
>> --
>> Regards Ron de Bruin
>> http://www.rondebruin.nl
>>
>>
>>
>> "Ron de Bruin" <rondebruin@kabelfoon.nl> wrote in message news:%23cBP57dQFHA.508@TK2MSFTNGP12.phx.gbl...
>> > Hi Jeff
>> >
>> > I must go now but will give you a example this evening or tomorrow
>> >
>> > --
>> > Regards Ron de Bruin
>> > http://www.rondebruin.nl
>> >
>> >
>> >
>> > "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:C38D25A9-C3C5-4FD2-9502-5B0262ED1259@microsoft.com...
>> >> Thanks again..... Just to push my luck: What if I wanted to copy every 50th
>> >> row (starting at row 100) and bring it back to the consolidating workbook?
>> >> This would require varying number of rows being copied as the size of the
>> >> source workbooks differ.........
>> >>
>> >> Any hope?
>> >>
>> >>
>> >>
>> >>
>> >> "Ron de Bruin" wrote:
>> >>
>> >>> I have a example on my site Jeff
>> >>> http://www.rondebruin.nl/copy3.htm
>> >>>
>> >>> Or with formulas
>> >>> http://www.rondebruin.nl/summary2.htm
>> >>>
>> >>>
>> >>> --
>> >>> Regards Ron de Bruin
>> >>> http://www.rondebruin.nl
>> >>>
>> >>>
>> >>>
>> >>> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
>> >>> > Hi All,
>> >>> >
>> >>> > I'd like to be able to go to each workbook in a folder and copy the same
>> >>> > data range from each and paste into a consolidated workbook. For example, go
>> >>> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
>> >>> > paste into Consolidated.xls..... This implies that the contents copied from
>> >>> > workbook A would go into row 1, the contents from workbook B would go into
>> >>> > row 2, and so on....
>> >>> >
>> >>> > Any help would be greatly appreciated!
>> >>>
>> >>>
>> >>>
>> >
>> >
>>
>>
>>

[JEFF]

Perfect.... Thanks again.

"Ron de Bruin" wrote:

> Try this to insert the file name in A
>
> Do While FNames <> ""
> Set mybook = Workbooks.Open(FNames)
> For rw = 75 To LastRow(mybook.Sheets(1)) Step 50
> Set sourceRange = mybook.Worksheets(1).Rows(rw)
> Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> sourceRange.Copy destrange
> If rw = 75 Then
> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)), "A").Value = mybook.Name
> End If
> Next
> mybook.Close False
> FNames = Dir()
> Loop
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
>
> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:6D46C700-B629-4BD3-A8E5-9A99F1ADBF82@microsoft.com...
> > Genius...... One thing: As I customized it for my needs, I now have it
> > returning the file name in a row above the associated data. Couldn't quite
> > figure out how to have the file name be in the same row as the first line of
> > data retrieved from that file.....
> >
> > Thanks!
> >
> >
> >
> > Sub Every_Nth_Row()
> >
> >
> > Dim basebook As Workbook
> > Dim mybook As Workbook
> > Dim sourceRange As Range
> > Dim destrange As Range
> > Dim rw As Long
> > Dim SourceRcount As Long
> > Dim FNames As String
> > Dim MyPath As String
> > Dim SaveDriveDir As String
> >
> > SaveDriveDir = CurDir
> > MyPath = "Y:\Sales\Target Customer\2005 Mainframe Download - Main"
> >
> > ChDrive MyPath
> > ChDir MyPath
> > FNames = Dir("CO*RG***-0*M.xls")
> >
> > If Len(FNames) = 0 Then
> > MsgBox "No files in the Directory"
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Exit Sub
> > End If
> >
> > Application.ScreenUpdating = False
> > Set basebook = ThisWorkbook
> > basebook.Worksheets(1).Cells.Clear
> > 'clear all cells on the first sheet
> >
> > Do While FNames <> ""
> > Set mybook = Workbooks.Open(FNames)
> >
> >
> > ' This will add the workbook name in column A if you want
> > basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1,
> > "A").Value = mybook.Name
> >
> >
> >
> > '***************** START ROW ---- STEP NUMBER OF ROWS
> > *******************************
> >
> > For rw = 1337 To LastRow(mybook.Sheets(1)) Step 61
> > Set sourceRange = mybook.Worksheets(1).Rows(rw)
> > Set destrange =
> > basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> > sourceRange.Copy destrange
> > Next
> >
> > mybook.Close False
> > FNames = Dir()
> > Loop
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Application.ScreenUpdating = True
> > End Sub
> >
> > Function LastRow(sh As Worksheet)
> > On Error Resume Next
> > LastRow = sh.Cells.Find(What:="*", _
> > After:=sh.Range("A1"), _
> > Lookat:=xlPart, _
> > LookIn:=xlFormulas, _
> > SearchOrder:=xlByRows, _
> > SearchDirection:=xlPrevious, _
> > MatchCase:=False).Row
> > On Error GoTo 0
> > End Function
> >
> >
> >
> >
> >
> >
> > "Ron de Bruin" wrote:
> >
> >> Hi Jeff
> >>
> >> Here is a basic example
> >> Copy both (macro and function in a normal module)
> >> Post back if you have problems
> >>
> >> Sub TestFile1()
> >> Dim basebook As Workbook
> >> Dim mybook As Workbook
> >> Dim sourceRange As Range
> >> Dim destrange As Range
> >> Dim rw As Long
> >> Dim SourceRcount As Long
> >> Dim FNames As String
> >> Dim MyPath As String
> >> Dim SaveDriveDir As String
> >>
> >> SaveDriveDir = CurDir
> >> MyPath = "C:\Data"
> >> ChDrive MyPath
> >> ChDir MyPath
> >> FNames = Dir("*.xls")
> >> If Len(FNames) = 0 Then
> >> MsgBox "No files in the Directory"
> >> ChDrive SaveDriveDir
> >> ChDir SaveDriveDir
> >> Exit Sub
> >> End If
> >>
> >> Application.ScreenUpdating = False
> >> Set basebook = ThisWorkbook
> >> basebook.Worksheets(1).Cells.Clear
> >> 'clear all cells on the first sheet
> >>
> >> Do While FNames <> ""
> >> Set mybook = Workbooks.Open(FNames)
> >> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A").Value = mybook.Name
> >> ' This will add the workbook name in column A if you want
> >>
> >> For rw = 100 To LastRow(mybook.Sheets(1)) Step 50
> >> Set sourceRange = mybook.Worksheets(1).Rows(rw)
> >> Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> >> sourceRange.Copy destrange
> >> Next
> >>
> >> mybook.Close False
> >> FNames = Dir()
> >> Loop
> >> ChDrive SaveDriveDir
> >> ChDir SaveDriveDir
> >> Application.ScreenUpdating = True
> >> End Sub
> >>
> >> Function LastRow(sh As Worksheet)
> >> On Error Resume Next
> >> LastRow = sh.Cells.Find(What:="*", _
> >> After:=sh.Range("A1"), _
> >> Lookat:=xlPart, _
> >> LookIn:=xlFormulas, _
> >> SearchOrder:=xlByRows, _
> >> SearchDirection:=xlPrevious, _
> >> MatchCase:=False).Row
> >> On Error GoTo 0
> >> End Function
> >>
> >>
> >> --
> >> Regards Ron de Bruin
> >> http://www.rondebruin.nl
> >>
> >>
> >>
> >> "Ron de Bruin" <rondebruin@kabelfoon.nl> wrote in message news:%23cBP57dQFHA.508@TK2MSFTNGP12.phx.gbl...
> >> > Hi Jeff
> >> >
> >> > I must go now but will give you a example this evening or tomorrow
> >> >
> >> > --
> >> > Regards Ron de Bruin
> >> > http://www.rondebruin.nl
> >> >
> >> >
> >> >
> >> > "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:C38D25A9-C3C5-4FD2-9502-5B0262ED1259@microsoft.com...
> >> >> Thanks again..... Just to push my luck: What if I wanted to copy every 50th
> >> >> row (starting at row 100) and bring it back to the consolidating workbook?
> >> >> This would require varying number of rows being copied as the size of the
> >> >> source workbooks differ.........
> >> >>
> >> >> Any hope?
> >> >>
> >> >>
> >> >>
> >> >>
> >> >> "Ron de Bruin" wrote:
> >> >>
> >> >>> I have a example on my site Jeff
> >> >>> http://www.rondebruin.nl/copy3.htm
> >> >>>
> >> >>> Or with formulas
> >> >>> http://www.rondebruin.nl/summary2.htm
> >> >>>
> >> >>>
> >> >>> --
> >> >>> Regards Ron de Bruin
> >> >>> http://www.rondebruin.nl
> >> >>>
> >> >>>
> >> >>>
> >> >>> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> >> >>> > Hi All,
> >> >>> >
> >> >>> > I'd like to be able to go to each workbook in a folder and copy the same
> >> >>> > data range from each and paste into a consolidated workbook. For example, go
> >> >>> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
> >> >>> > paste into Consolidated.xls..... This implies that the contents copied from
> >> >>> > workbook A would go into row 1, the contents from workbook B would go into
> >> >>> > row 2, and so on....
> >> >>> >
> >> >>> > Any help would be greatly appreciated!
> >> >>>
> >> >>>
> >> >>>
> >> >
> >> >
> >>
> >>
> >>
>
>
>

[JEFF]

One last question: When I run it with the file names simply as Dir("*.xls"),
it only takes five minutes to return the data. If I use wild cards such as:
FNames = Dir("CO*RG***-0*M.xls"), it takes two hours -- but only has to
retrieve data from half the files in that directory .... Is that the price
of using wildcards?

Thanks again.

"Ron de Bruin" wrote:

> Try this to insert the file name in A
>
> Do While FNames <> ""
> Set mybook = Workbooks.Open(FNames)
> For rw = 75 To LastRow(mybook.Sheets(1)) Step 50
> Set sourceRange = mybook.Worksheets(1).Rows(rw)
> Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> sourceRange.Copy destrange
> If rw = 75 Then
> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)), "A").Value = mybook.Name
> End If
> Next
> mybook.Close False
> FNames = Dir()
> Loop
>
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
>
> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:6D46C700-B629-4BD3-A8E5-9A99F1ADBF82@microsoft.com...
> > Genius...... One thing: As I customized it for my needs, I now have it
> > returning the file name in a row above the associated data. Couldn't quite
> > figure out how to have the file name be in the same row as the first line of
> > data retrieved from that file.....
> >
> > Thanks!
> >
> >
> >
> > Sub Every_Nth_Row()
> >
> >
> > Dim basebook As Workbook
> > Dim mybook As Workbook
> > Dim sourceRange As Range
> > Dim destrange As Range
> > Dim rw As Long
> > Dim SourceRcount As Long
> > Dim FNames As String
> > Dim MyPath As String
> > Dim SaveDriveDir As String
> >
> > SaveDriveDir = CurDir
> > MyPath = "Y:\Sales\Target Customer\2005 Mainframe Download - Main"
> >
> > ChDrive MyPath
> > ChDir MyPath
> > FNames = Dir("CO*RG***-0*M.xls")
> >
> > If Len(FNames) = 0 Then
> > MsgBox "No files in the Directory"
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Exit Sub
> > End If
> >
> > Application.ScreenUpdating = False
> > Set basebook = ThisWorkbook
> > basebook.Worksheets(1).Cells.Clear
> > 'clear all cells on the first sheet
> >
> > Do While FNames <> ""
> > Set mybook = Workbooks.Open(FNames)
> >
> >
> > ' This will add the workbook name in column A if you want
> > basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1,
> > "A").Value = mybook.Name
> >
> >
> >
> > '***************** START ROW ---- STEP NUMBER OF ROWS
> > *******************************
> >
> > For rw = 1337 To LastRow(mybook.Sheets(1)) Step 61
> > Set sourceRange = mybook.Worksheets(1).Rows(rw)
> > Set destrange =
> > basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> > sourceRange.Copy destrange
> > Next
> >
> > mybook.Close False
> > FNames = Dir()
> > Loop
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Application.ScreenUpdating = True
> > End Sub
> >
> > Function LastRow(sh As Worksheet)
> > On Error Resume Next
> > LastRow = sh.Cells.Find(What:="*", _
> > After:=sh.Range("A1"), _
> > Lookat:=xlPart, _
> > LookIn:=xlFormulas, _
> > SearchOrder:=xlByRows, _
> > SearchDirection:=xlPrevious, _
> > MatchCase:=False).Row
> > On Error GoTo 0
> > End Function
> >
> >
> >
> >
> >
> >
> > "Ron de Bruin" wrote:
> >
> >> Hi Jeff
> >>
> >> Here is a basic example
> >> Copy both (macro and function in a normal module)
> >> Post back if you have problems
> >>
> >> Sub TestFile1()
> >> Dim basebook As Workbook
> >> Dim mybook As Workbook
> >> Dim sourceRange As Range
> >> Dim destrange As Range
> >> Dim rw As Long
> >> Dim SourceRcount As Long
> >> Dim FNames As String
> >> Dim MyPath As String
> >> Dim SaveDriveDir As String
> >>
> >> SaveDriveDir = CurDir
> >> MyPath = "C:\Data"
> >> ChDrive MyPath
> >> ChDir MyPath
> >> FNames = Dir("*.xls")
> >> If Len(FNames) = 0 Then
> >> MsgBox "No files in the Directory"
> >> ChDrive SaveDriveDir
> >> ChDir SaveDriveDir
> >> Exit Sub
> >> End If
> >>
> >> Application.ScreenUpdating = False
> >> Set basebook = ThisWorkbook
> >> basebook.Worksheets(1).Cells.Clear
> >> 'clear all cells on the first sheet
> >>
> >> Do While FNames <> ""
> >> Set mybook = Workbooks.Open(FNames)
> >> basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A").Value = mybook.Name
> >> ' This will add the workbook name in column A if you want
> >>
> >> For rw = 100 To LastRow(mybook.Sheets(1)) Step 50
> >> Set sourceRange = mybook.Worksheets(1).Rows(rw)
> >> Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Worksheets(1)) + 1, "A")
> >> sourceRange.Copy destrange
> >> Next
> >>
> >> mybook.Close False
> >> FNames = Dir()
> >> Loop
> >> ChDrive SaveDriveDir
> >> ChDir SaveDriveDir
> >> Application.ScreenUpdating = True
> >> End Sub
> >>
> >> Function LastRow(sh As Worksheet)
> >> On Error Resume Next
> >> LastRow = sh.Cells.Find(What:="*", _
> >> After:=sh.Range("A1"), _
> >> Lookat:=xlPart, _
> >> LookIn:=xlFormulas, _
> >> SearchOrder:=xlByRows, _
> >> SearchDirection:=xlPrevious, _
> >> MatchCase:=False).Row
> >> On Error GoTo 0
> >> End Function
> >>
> >>
> >> --
> >> Regards Ron de Bruin
> >> http://www.rondebruin.nl
> >>
> >>
> >>
> >> "Ron de Bruin" <rondebruin@kabelfoon.nl> wrote in message news:%23cBP57dQFHA.508@TK2MSFTNGP12.phx.gbl...
> >> > Hi Jeff
> >> >
> >> > I must go now but will give you a example this evening or tomorrow
> >> >
> >> > --
> >> > Regards Ron de Bruin
> >> > http://www.rondebruin.nl
> >> >
> >> >
> >> >
> >> > "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:C38D25A9-C3C5-4FD2-9502-5B0262ED1259@microsoft.com...
> >> >> Thanks again..... Just to push my luck: What if I wanted to copy every 50th
> >> >> row (starting at row 100) and bring it back to the consolidating workbook?
> >> >> This would require varying number of rows being copied as the size of the
> >> >> source workbooks differ.........
> >> >>
> >> >> Any hope?
> >> >>
> >> >>
> >> >>
> >> >>
> >> >> "Ron de Bruin" wrote:
> >> >>
> >> >>> I have a example on my site Jeff
> >> >>> http://www.rondebruin.nl/copy3.htm
> >> >>>
> >> >>> Or with formulas
> >> >>> http://www.rondebruin.nl/summary2.htm
> >> >>>
> >> >>>
> >> >>> --
> >> >>> Regards Ron de Bruin
> >> >>> http://www.rondebruin.nl
> >> >>>
> >> >>>
> >> >>>
> >> >>> "JEFF" <JEFF@discussions.microsoft.com> wrote in message news:08458E21-737A-4628-A202-98EBC45E3795@microsoft.com...
> >> >>> > Hi All,
> >> >>> >
> >> >>> > I'd like to be able to go to each workbook in a folder and copy the same
> >> >>> > data range from each and paste into a consolidated workbook. For example, go
> >> >>> > to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
> >> >>> > paste into Consolidated.xls..... This implies that the contents copied from
> >> >>> > workbook A would go into row 1, the contents from workbook B would go into
> >> >>> > row 2, and so on....
> >> >>> >
> >> >>> > Any help would be greatly appreciated!
> >> >>>
> >> >>>
> >> >>>
> >> >
> >> >
> >>
> >>
> >>
>
>
>