I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

I am receiving the message "PasteSpecial of Range Class failed" when I try to
run the module.

Any suggestions here?

Basicall I have one column of data that I need to pull from 50 workbooks (1
file x 50 states). Then I want the data that is being pulled to one workbook
and have it set up as a row for each state.

"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

Thank you. That would be very useful.
Please let me know what the Title of the tutorial will be, and also when it
is posted.

Appreciate your help.

"Ron de Bruin" wrote:

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

Hi IntricateFool

This tester is working for me for all files in C:\Data

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum 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
rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A1:A10")
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

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


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



"IntricateFool" wrote in message
...
Thank you. That would be very useful.
Please let me know what the Title of the tutorial will be, and also when it
is posted.

Appreciate your help.

"Ron de Bruin" wrote:

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

Thanks so much. Your have been of much help!

"Ron de Bruin" wrote:

Hi IntricateFool

This tester is working for me for all files in C:\Data

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum 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
rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A1:A10")
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

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


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



"IntricateFool" wrote in message
...
Thank you. That would be very useful.
Please let me know what the Title of the tutorial will be, and also when it
is posted.

Appreciate your help.

"Ron de Bruin" wrote:

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

You are welcome

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



"IntricateFool" wrote in message
...
Thanks so much. Your have been of much help!

"Ron de Bruin" wrote:

Hi IntricateFool

This tester is working for me for all files in C:\Data

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum 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
rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A1:A10")
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

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


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



"IntricateFool" wrote in message
...
Thank you. That would be very useful.
Please let me know what the Title of the tutorial will be, and also when it
is posted.

Appreciate your help.

"Ron de Bruin" wrote:

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

Could you recommend a good starting place for learning VBA?

"Ron de Bruin" wrote:

You are welcome

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



"IntricateFool" wrote in message
...
Thanks so much. Your have been of much help!

"Ron de Bruin" wrote:

Hi IntricateFool

This tester is working for me for all files in C:\Data

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum 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
rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A1:A10")
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

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


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



"IntricateFool" wrote in message
...
Thank you. That would be very useful.
Please let me know what the Title of the tutorial will be, and also when it
is posted.

Appreciate your help.

"Ron de Bruin" wrote:

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

hi IntricateFool

Read the newsgroups
You can use this tool that also have a list of Excel sites
http://www.rondebruin.nl/Google.htm

Buy this book
http://www.amazon.com/gp/product/076...48905?n=283155

And next year
http://www.amazon.com/gp/product/032...48905?n=283155


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



"IntricateFool" wrote in message
...
Could you recommend a good starting place for learning VBA?

"Ron de Bruin" wrote:

You are welcome

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



"IntricateFool" wrote in message
...
Thanks so much. Your have been of much help!

"Ron de Bruin" wrote:

Hi IntricateFool

This tester is working for me for all files in C:\Data

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum 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
rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A1:A10")
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

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


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



"IntricateFool" wrote in message
...
Thank you. That would be very useful.
Please let me know what the Title of the tutorial will be, and also when it
is posted.

Appreciate your help.

"Ron de Bruin" wrote:

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!

See the Better together that have both books for a special price on this link
http://www.amazon.com/gp/product/032...48905?n=283155

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



"Ron de Bruin" wrote in message ...
hi IntricateFool

Read the newsgroups
You can use this tool that also have a list of Excel sites
http://www.rondebruin.nl/Google.htm

Buy this book
http://www.amazon.com/gp/product/076...48905?n=283155

And next year
http://www.amazon.com/gp/product/032...48905?n=283155


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



"IntricateFool" wrote in message
...
Could you recommend a good starting place for learning VBA?

"Ron de Bruin" wrote:

You are welcome

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



"IntricateFool" wrote in message
...
Thanks so much. Your have been of much help!

"Ron de Bruin" wrote:

Hi IntricateFool

This tester is working for me for all files in C:\Data

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum 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
rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A1:A10")
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

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


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



"IntricateFool" wrote in message
...
Thank you. That would be very useful.
Please let me know what the Title of the tutorial will be, and also when it
is posted.

Appreciate your help.

"Ron de Bruin" wrote:

I post a tested example this evening

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



"IntricateFool" wrote in message
...
To better describe even further...

I have one column of data I need from 50 different files. I would like this
column to be as one row in one seperate workbook. So all together i will have
50 rows of data in this seperate workbook.

Column C <--- in 50 files (1 for each state)
State Abbrev
State Plan
Tier
Special Need
Co-Pay

Seperate Workbook:
Column A | B | C | D | E
1 State Abbrev State Plan Tier Special Need Co-Pay
2 " " " " " " " "
" "
50 State Abbrev State Plan Tier Special Need Co-Pay

Thanks for your help.



"Ron de Bruin" wrote:

If you want to transpose use PasteSpeial with the last argument True

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False

And change rnum = rnum + SourceRcount to
rnum = rnum + 1

You can delete
SourceRcount = sourceRange.Rows.Count

If you need more help post back



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



"IntricateFool" wrote in message
...
I finally figured out a way to extract data from all workbooks contained in
one folder. The data being extracted is composed in one column (column b x 26
rows), extracted from 50 files (one for each state). I need this data to be
put into a basebook as rows (transposed) so that for each state abbreviation,
all data will appear to the right of the state (the first row of column b is
the state abbreviation) . I know there is a way to pull in the data so that
it is showing 26 columns with all the data placed directly under these
columns (so 50 rows will be shown, one for each state). I just don't know how
to manipulate the vba accordingly.

As of now, it just pulls everything one block at a time, and now I have
50x26 rows...
Here is how I am pulling the data now:

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

SaveDriveDir = CurDir
MyPath = "C:\!Data\Data Collection"
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("Sheet1").Cells.Clear

rnum = 1

Do While FNames < ""
Set mybook = Workbooks.Open(FNames, Password:="chris",
WriteResPassword:="chris", UpdateLinks:=0)
Set sourceRange = mybook.Worksheets("Please Complete
(Medical)").Range("C6:C31")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets("Sheet1").Cells(rnum, "A")

basebook.Worksheets("Sheet1").Cells(rnum, "D").Value = mybook.Name

sourceRange.Copy destrange

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

Need only 50 rows.
Someone please help...!