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 ***