Hello Excel Experts and Users,

The Copy Destination lines of this code cause a failure(yellow hi-light).
My intent is to copy the 39 row range in workbook "Models" sheet "Adams", go
to workbook "A1Results", sheet "Adams" and paste special, transpose to a row
in column C. Then do the same thing in the next sheet in "Models" until it
gets to sheet "Carroll", doing a copy, paste special from that sheet and
ending the loop.

Copies from the 10 sheets in workbook "Models" into the 10 sheets in
workbook "A1Results" with the same names.

Can't get past the copy destination to even see if my Do Until Loop will
work.

Sub Models_To_Results()
Dim WS As Worksheet
Set WS = Worksheets("Adams")

Do Until WS.Name = "Carroll"
Range("IV29").End(xlToLeft).Resize(39, 1).Copy
Workbooks("A1Results.xls").Activate
Range("C100").End(xlUp).Offset(1, 0). _
PasteSpecial , xlPasteValues, Transpose:=True
Set WS = WS.Next
Loop

End Sub

Thanks for any help.
Regards,
Howard

Hi Howard,

You've got a lot of unqualified references going on in your code, and the
loop won't work as constucted. Try the following sub to see if it does what
you want.

It assumes the following:

- you will place the code a standard module in Workbooks("Models").
- the sheets are arranged in such order that all sheets data will be copied
FROM are LEFT of Sheets("Carroll")


Sub CopyToOtherBook5()
' Copies a range in wbkSource to a location in wbkTarget
' Data is transposed from vertical (source) to horizontal (target)

Dim wbkSource As Workbook, wbkTarget As Workbook
Dim rngSource As Range, rngTarget As Range
Dim i As Long, lShts As Long
Dim sName As String, vaData As Variant

Set wbkSource = ThisWorkbook
Set wbkTarget = Workbooks("A1Results.xls")

lShts = wbkSource.Sheets("Carroll").Index - 1

For i = 1 To lShts
sName = wbkSource.Sheets(i).Name
vaData = wbkSource.Sheets(i).Range("IV29").End(xlToLeft).Re size(39, 1)
Set rngTarget =
wbkTarget.Sheets(sName).Range("C100").End(xlUp).Of fset(1, 0).Resize(1, 39)
rngTarget = Application.WorksheetFunction.Transpose(vaData)
Next

End Sub

HTH
Regards,
GS

Thanks, GS. That does the trick, works great. I appreciate the help.

Regards,
Howard


"L. Howard Kittle" wrote in message
. ..
Hello Excel Experts and Users,

The Copy Destination lines of this code cause a failure(yellow hi-light).
My intent is to copy the 39 row range in workbook "Models" sheet "Adams",
go to workbook "A1Results", sheet "Adams" and paste special, transpose to
a row in column C. Then do the same thing in the next sheet in "Models"
until it gets to sheet "Carroll", doing a copy, paste special from that
sheet and ending the loop.

Copies from the 10 sheets in workbook "Models" into the 10 sheets in
workbook "A1Results" with the same names.

Can't get past the copy destination to even see if my Do Until Loop will
work.

Sub Models_To_Results()
Dim WS As Worksheet
Set WS = Worksheets("Adams")

Do Until WS.Name = "Carroll"
Range("IV29").End(xlToLeft).Resize(39, 1).Copy
Workbooks("A1Results.xls").Activate
Range("C100").End(xlUp).Offset(1, 0). _
PasteSpecial , xlPasteValues, Transpose:=True
Set WS = WS.Next
Loop

End Sub

Thanks for any help.
Regards,
Howard