Retrieven data from closed workbooks - Ron de Bruin
 

Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieven data from closed workbooks - Ron de Bruin
 

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieven data from closed workbooks - Ron de Bruin
 

Thanks, I'll take a look at your site.
(Sorry for sending 2 posts, I had not finished the 1st one when I hit "post")

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieven data from closed workbooks - Ron de Bruin
 

Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieven data from closed workbooks - Ron de Bruin
 

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieven data from closed workbooks - Ron de Bruin
 

Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieven data from closed workbooks - Ron de Bruin
 

Hi

You miss a "End if" in your code


If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

' code

End if



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


"Myriam" wrote in message ...
Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieve data from closed workbooks - Ron de Bruin
 

I added the "End if" but it still did not work. I moved the Loop right
before the End Sub and it stopped giving me the error(though this new
position does not make sense). Now, it opens the first closed book marks
the correct column and stops at "Set destrange =
basebook.Worksheets("Sheet1").Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)"
What am I doing wrong?
Thanks!

"Ron de Bruin" wrote:

Hi

You miss a "End if" in your code


If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

' code

End if



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


"Myriam" wrote in message ...
Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieve data from closed workbooks - Ron de Bruin
 

Hi Myriam


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()
End If

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub



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


"Myriam" wrote in message ...
I added the "End if" but it still did not work. I moved the Loop right
before the End Sub and it stopped giving me the error(though this new
position does not make sense). Now, it opens the first closed book marks
the correct column and stops at "Set destrange =
basebook.Worksheets("Sheet1").Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)"
What am I doing wrong?
Thanks!

"Ron de Bruin" wrote:

Hi

You miss a "End if" in your code


If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

' code

End if



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


"Myriam" wrote in message ...
Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieve data from closed workbooks - Ron de Bruin
 

Ron,
I still can't make it work. :(
I DO need to copy "values" only. Now the program is not asking
for "Do Loop" but keeps running ("not responding") until I hit Escape
and End.
Thanks for your patience and help!

"Ron de Bruin" wrote:

Hi Myriam


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()
End If

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub



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


"Myriam" wrote in message ...
I added the "End if" but it still did not work. I moved the Loop right
before the End Sub and it stopped giving me the error(though this new
position does not make sense). Now, it opens the first closed book marks
the correct column and stops at "Set destrange =
basebook.Worksheets("Sheet1").Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)"
What am I doing wrong?
Thanks!

"Ron de Bruin" wrote:

Hi

You miss a "End if" in your code


If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

' code

End if



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


"Myriam" wrote in message ...
Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message ...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieve data from closed workbooks - Ron de Bruin
 

This line is on the wrong place
FNames = Dir()



Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets(2).Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets(1).Columns("A:A")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
End If

FNames = Dir()
Loop




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


"Myriam" wrote in message ...
Ron,
I still can't make it work. :(
I DO need to copy "values" only. Now the program is not asking
for "Do Loop" but keeps running ("not responding") until I hit Escape
and End.
Thanks for your patience and help!

"Ron de Bruin" wrote:

Hi Myriam


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()
End If

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub



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


"Myriam" wrote in message ...
I added the "End if" but it still did not work. I moved the Loop right
before the End Sub and it stopped giving me the error(though this new
position does not make sense). Now, it opens the first closed book marks
the correct column and stops at "Set destrange =
basebook.Worksheets("Sheet1").Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)"
What am I doing wrong?
Thanks!

"Ron de Bruin" wrote:

Hi

You miss a "End if" in your code


If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

' code

End if



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


"Myriam" wrote in message ...
Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message
...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieve data from closed workbooks - Ron de Bruin
 

Hi Myriam

You can use Paste Special to do this
See the VBA help for more information

First the paste the values and then the formats



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


"Myriam" wrote in message ...
Thanks, Ron!!!
That was the problem. It is working beautifully!!

To copy only values (not formulas) I only substituted
sourceRange.Copy destrange
with
destrange.Value = sourceRange.Value

I DO want to keep the format, how do I add "keep format also"?
Thanks again. You are great!


"Ron de Bruin" wrote:

This line is on the wrong place
FNames = Dir()



Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets(2).Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets(1).Columns("A:A")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
End If

FNames = Dir()
Loop




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


"Myriam" wrote in message ...
Ron,
I still can't make it work. :(
I DO need to copy "values" only. Now the program is not asking
for "Do Loop" but keeps running ("not responding") until I hit Escape
and End.
Thanks for your patience and help!

"Ron de Bruin" wrote:

Hi Myriam


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()
End If

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub



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


"Myriam" wrote in message ...
I added the "End if" but it still did not work. I moved the Loop right
before the End Sub and it stopped giving me the error(though this new
position does not make sense). Now, it opens the first closed book marks
the correct column and stops at "Set destrange =
basebook.Worksheets("Sheet1").Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)"
What am I doing wrong?
Thanks!

"Ron de Bruin" wrote:

Hi

You miss a "End if" in your code


If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

' code

End if



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


"Myriam" wrote in message ...
Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message
...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!

Retrieve data from closed workbooks - Ron de Bruin
 

Thanks again. I really appreciate your help.

"Ron de Bruin" wrote:

Hi Myriam

You can use Paste Special to do this
See the VBA help for more information

First the paste the values and then the formats



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


"Myriam" wrote in message ...
Thanks, Ron!!!
That was the problem. It is working beautifully!!

To copy only values (not formulas) I only substituted
sourceRange.Copy destrange
with
destrange.Value = sourceRange.Value

I DO want to keep the format, how do I add "keep format also"?
Thanks again. You are great!


"Ron de Bruin" wrote:

This line is on the wrong place
FNames = Dir()



Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets(2).Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets(1).Columns("A:A")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
End If

FNames = Dir()
Loop




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


"Myriam" wrote in message ...
Ron,
I still can't make it work. :(
I DO need to copy "values" only. Now the program is not asking
for "Do Loop" but keeps running ("not responding") until I hit Escape
and End.
Thanks for your patience and help!

"Ron de Bruin" wrote:

Hi Myriam


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then
Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)
sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()
End If

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub



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


"Myriam" wrote in message ...
I added the "End if" but it still did not work. I moved the Loop right
before the End Sub and it stopped giving me the error(though this new
position does not make sense). Now, it opens the first closed book marks
the correct column and stops at "Set destrange =
basebook.Worksheets("Sheet1").Cells(rnum, "A"). _
Resize(.Rows.Count, .Columns.Count)"
What am I doing wrong?
Thanks!

"Ron de Bruin" wrote:

Hi

You miss a "End if" in your code


If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

' code

End if



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


"Myriam" wrote in message ...
Here it is:


Sub DataTables()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = Worksheets("Table1").Range("B1")
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
'clear all cells on the first sheet
Colnum = 1

Do While FNames < ""

If Left(FNames, 4) = basebook.Worksheets("Tables1").Range("A1").Text Then

Set mybook = Workbooks.Open(Filename:=FNames, Password:="mypassword")
Set sourceRange = mybook.Worksheets("Tables2").Columns("E:E")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets("Sheet1").Columns(Colnum)

sourceRange.Copy destrange

' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets("Sheet1").Cells(rnum,
"A"). _
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()

Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub






"Ron de Bruin" wrote:

Hi Myriam

Show me the code you are using now



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


"Myriam" wrote in message ...
Ron,
I plugged in my sheet names, etc. and I keep getting a
compile error: Loop without Do
I copied and pasted your code in my Module. You
do have a "Do While" at the beginning and a "Loop" at the end...
Why am I getting that compile error?
Thanks!!

"Ron de Bruin" wrote:

I don't read your question good

Have you try this
http://www.rondebruin.nl/copy3.htm#column



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


"Ron de Bruin" wrote in message ...
Hi Myriam

You can use Pastespecial
It have a transpose argument

See the VBA help for this
If you need more help post back



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


"Myriam" wrote in message
...
I am using Ron's code to retrieve data from closed workbooks.
The code works wonderful but I need to transpose the output on the
destination book because I am copying a complete column from each workbook
and I want to have the name of the book as the title.
Instead of
e.g. Range1 Book1
Range2 Book2
Range3 Book3
I need it:
Book1................ Book2 ................. Book3
Range1(ColumnC) Range2(ColumnC) Range3(ColumnC) ETC.
Thanks in advance for the help!