Extracing Data from Unopened workbooks
 

Hi there,

Lets assume 100 sheets. 99 Data and 1 Master.
Lets assume all cells located in the same subdirectory /test/results

In the master I require an extract (ie results of certain cell refs)
from the 99 data sheets. It can be a one time extraction, ie does not
need to be linked.

Lets say I require Cells b1,c2 and d3 in the master

Is there any VB that I could write that would go to the sheet copy the
data and paste it into the Master sheet
(perhaps even without opening the workbook)

I appreciate any guidance... :)

Thanks

D



*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

Hi Darin

I have example code here
http://www.rondebruin.nl/tips.htm


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


"Darin Kramer" wrote in message ...


Hi there,

Lets assume 100 sheets. 99 Data and 1 Master.
Lets assume all cells located in the same subdirectory /test/results

In the master I require an extract (ie results of certain cell refs)
from the 99 data sheets. It can be a one time extraction, ie does not
need to be linked.

Lets say I require Cells b1,c2 and d3 in the master

Is there any VB that I could write that would go to the sheet copy the
data and paste it into the Master sheet
(perhaps even without opening the workbook)

I appreciate any guidance... :)

Thanks

D



*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

Hi Ron,

Looks like a good start ! - I am using the one crate a summary worksheet
from different workbooks.

I need to be able to :
Extract data from MORE THAN One sheet from each of the 99 data files. I
tried to add another sheet name, but it didnt work.

Also I need the results of the each successive extraction to appear on
the same book, not a different one...

Appreciate your help...

Kind Regards

Darin


*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

I think you want run this one on each workbook ?
http://www.rondebruin.nl/summary.htm


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


"Darin Kramer" wrote in message ...

Hi Ron,

Looks like a good start ! - I am using the one crate a summary worksheet
from different workbooks.

I need to be able to :
Extract data from MORE THAN One sheet from each of the 99 data files. I
tried to add another sheet name, but it didnt work.

Also I need the results of the each successive extraction to appear on
the same book, not a different one...

Appreciate your help...

Kind Regards

Darin


*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

This is exactly what I was lookign for as well. Just I need to do it a little
differantly.

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

"Ron de Bruin" wrote:

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

This would be a better description of what I'm trying to do. The code doesn't
work but you can see what I'm trying to do.

Sub GetData_Example2()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant

SaveDriveDir = CurDir
MyPath = "W:\Aurora Daily Production Report" 'or use "W:\Aurora Daily
Production Report"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xls")

If FName = False Then
'do nothing
Else
GetData FName, "Daily Report", "E3:E33",
Sheets("Sheet1").Range("A21", Transpose:=True), True
GetData FName, "Daily Report", "H3:H49",
Sheets("Sheet1").Range("A22", Transpose:=True), True
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub

"Mike Punko" wrote:

This is exactly what I was lookign for as well. Just I need to do it a little
differantly.

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

"Ron de Bruin" wrote:

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

You can use pastespecial and transpose

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

Do you want to do copy both ranges(A2:A5 and B2:B10 ) from each sheet
in one row on the summary sheet.

Correct ?



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


"Mike Punko" wrote in message ...
This is exactly what I was lookign for as well. Just I need to do it a little
differantly.

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

"Ron de Bruin" wrote:

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

Both ranges are on the same sheet/same workbook and they are being pulled
into to the same sheet/differant workbook. I tried using your code for file
selection to do this but I can't get the "Transpose" Paste Special option to
work in it.

"Ron de Bruin" wrote:

You can use pastespecial and transpose

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

Do you want to do copy both ranges(A2:A5 and B2:B10 ) from each sheet
in one row on the summary sheet.

Correct ?



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


"Mike Punko" wrote in message ...
This is exactly what I was lookign for as well. Just I need to do it a little
differantly.

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

"Ron de Bruin" wrote:

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

Hi Mike

I think it will be tomorrow when I reply
Almost bedtime here

After work I will try to help you


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


"Mike Punko" wrote in message ...
Both ranges are on the same sheet/same workbook and they are being pulled
into to the same sheet/differant workbook. I tried using your code for file
selection to do this but I can't get the "Transpose" Paste Special option to
work in it.

"Ron de Bruin" wrote:

You can use pastespecial and transpose

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

Do you want to do copy both ranges(A2:A5 and B2:B10 ) from each sheet
in one row on the summary sheet.

Correct ?



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


"Mike Punko" wrote in message ...
This is exactly what I was lookign for as well. Just I need to do it a little
differantly.

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

"Ron de Bruin" wrote:

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

Any updates, Still can't get the data to transpose.

"Ron de Bruin" wrote:

Hi Mike

I think it will be tomorrow when I reply
Almost bedtime here

After work I will try to help you


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


"Mike Punko" wrote in message ...
Both ranges are on the same sheet/same workbook and they are being pulled
into to the same sheet/differant workbook. I tried using your code for file
selection to do this but I can't get the "Transpose" Paste Special option to
work in it.

"Ron de Bruin" wrote:

You can use pastespecial and transpose

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

Do you want to do copy both ranges(A2:A5 and B2:B10 ) from each sheet
in one row on the summary sheet.

Correct ?



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


"Mike Punko" wrote in message ...
This is exactly what I was lookign for as well. Just I need to do it a little
differantly.

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

"Ron de Bruin" wrote:

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***

Extracing Data from Unopened workbooks
 

Hi Mike

Maybe this is what you want

Copy A1:A5 from Sheet1 to A1:E1 on Sheet2 of each workbook in the folder C:\Data


Sub Copyrange_1()
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

MyPath = "C:\Data"
'Add a slash at the end if the user forget
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

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

On Error GoTo CleanUp
Application.ScreenUpdating = False

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

Set sourceRange = mybook.Worksheets("Sheet1").Range("a1:A5")
Set destrange = mybook.Worksheets("Sheet2").Range("a1")
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, True
Application.CutCopyMode = False


mybook.Close True
FNames = Dir()
Loop

CleanUp:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

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


"Mike Punko" wrote in message ...
Any updates, Still can't get the data to transpose.

"Ron de Bruin" wrote:

Hi Mike

I think it will be tomorrow when I reply
Almost bedtime here

After work I will try to help you


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


"Mike Punko" wrote in message ...
Both ranges are on the same sheet/same workbook and they are being pulled
into to the same sheet/differant workbook. I tried using your code for file
selection to do this but I can't get the "Transpose" Paste Special option to
work in it.

"Ron de Bruin" wrote:

You can use pastespecial and transpose

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

Do you want to do copy both ranges(A2:A5 and B2:B10 ) from each sheet
in one row on the summary sheet.

Correct ?



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


"Mike Punko" wrote in message ...
This is exactly what I was lookign for as well. Just I need to do it a little
differantly.

I need to copy A2:A5 to B2:E2 then copy B2:B10 to F2:N2

"Ron de Bruin" wrote:

Hi Darin

If I understand you correct
Test this

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add

On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If


ColNum = 1
'The links to the first sheet will start in Column 1

For Each Sh In Basebook.Worksheets

If Sh.Name < Newsh.Name And Sh.Visible Then
RwNum = 1
Newsh.Cells(RwNum, ColNum).Value = Sh.Name
'Copy the sheet name in row 1

For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
RwNum = RwNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

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


"Ron de Bruin" wrote in message ...
I will make a example for you

First eat (5:31 here)


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


"Darin Kramer" wrote in message ...
:)

I could repeat that macro several times - it would work.
Question - I would prefer the data to be added in rows as opposed to
columns ie for it to list name on row a1, then first refe on row a2,
then on a3 (Currently it places results in a1,b1,c1)
Alternatively need a macro to select cells d1 to f1, cut the data and
paste into a2 to c2. Then cuts g1 to i1 and pastes into a3 to c3 etc
etc.... any ideas... ? : )

*** Sent via Developersdex http://www.developersdex.com ***