tyrese215
02-26-2009, 08:47 PM
Hi Everyone,
Here is my problem.... I have many workbooks in one folder that I would like to extract data from and dump into a consolidated workbook. Data that I want to extract begins on Row A7 to C7 from this source folder. This Data on Each workbook in this folder, however, has Different rows that the data range ends. eg some could finish on row 30 and some could finish on row 200.
I want to copy All of this range till the last record on each workbook in this source folder to my active workbook. This should be copied from row 7 on this destination workbook.
The copied data from each source workbook should be copied underneith eachother in my destination workbook.
I tried the following code but it fails to work... Can someone please help.. thank you
Sub xxxx()
Dim myDir As String, fn As String
myDir = "C:\xxx\Labor stuff\copy range code\Workbooks to copy\"
fn = Dir(myDir & "*.xls")
Do While fn <> ""
'If fn <> ThisWorkbook.Name Then
' For Each mySht In ActiveWorkbook.Sheets
' mySht.Unprotect Password:="xxx"
'Next
With Workbooks.Open(myDir & fn)
With .Sheets("Margin By Job Family - Perm").Range("a7:c" & .Cells(.Rows.Count, "a").End(xlUp))
ThisWorkbook.Sheets("merged").Range("a" & Rows.Count).End(xlUp)(2) _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
.Close False
End With
fn = Dir
Loop
End Sub
Here is my problem.... I have many workbooks in one folder that I would like to extract data from and dump into a consolidated workbook. Data that I want to extract begins on Row A7 to C7 from this source folder. This Data on Each workbook in this folder, however, has Different rows that the data range ends. eg some could finish on row 30 and some could finish on row 200.
I want to copy All of this range till the last record on each workbook in this source folder to my active workbook. This should be copied from row 7 on this destination workbook.
The copied data from each source workbook should be copied underneith eachother in my destination workbook.
I tried the following code but it fails to work... Can someone please help.. thank you
Sub xxxx()
Dim myDir As String, fn As String
myDir = "C:\xxx\Labor stuff\copy range code\Workbooks to copy\"
fn = Dir(myDir & "*.xls")
Do While fn <> ""
'If fn <> ThisWorkbook.Name Then
' For Each mySht In ActiveWorkbook.Sheets
' mySht.Unprotect Password:="xxx"
'Next
With Workbooks.Open(myDir & fn)
With .Sheets("Margin By Job Family - Perm").Range("a7:c" & .Cells(.Rows.Count, "a").End(xlUp))
ThisWorkbook.Sheets("merged").Range("a" & Rows.Count).End(xlUp)(2) _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
.Close False
End With
fn = Dir
Loop
End Sub