If I understand you correctly, here's one way:

Public Sub PstTranspose()
Dim rDest As Range
Dim rFound As Range
With Sheets("Sheet1")
Set rDest = .Range("A1").End(xlUp).Offset(1, 0).Resize(2, 8)
End With
With Sheets("Printers").Cells
Set rFound = .Find( _
What:="Text Description", _
After:=.Cells(.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchDirection:=xlNext, _
SearchOrder:=xlByColumns, _
MatchCase:=False)
If Not rFound Is Nothing Then _
rDest.Value = Application.Transpose( _
rFound.Offset(1, 0).Resize(8, 2).Value)
End With
End Sub

Note that you almost never need to select a range. Using the range
object directly makes your code smaller, faster, and IMO easier to
maintain.



In article ,
(Paul) wrote:

In Sheet "Printers" I have a column of over 15K rows.
Every 8 rows the data in Col A repeats.
I want to copy the corresponding cells in column B
and Transpose them into Sheet1 so the data in B aligns under the
headings
from col A.
So I am using a Search and Find to pick my next batch of rows to copy.
When I do the paste, my data is screwed up.
Can anyone see where I have gone wrong.

I am self taught and not too good on VB.

Thanks in advance.

Paul

I have the following code:
Sub PstTranspose()
'

Sheets("Printers").Activate
Cells.Find(What:="Text Description", After:=ActiveCell,
LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 1).Select
Range(ActiveCell, ActiveCell.Offset(7, 0)).Select
Selection.Copy
Worksheets("Sheet1").Activate
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Selection.End(xlUp).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True
ActiveSheet.Paste


End Sub