Transpose

K

kadium

I am trying to do the following with no luck. Please Help!!!!!

Example:
original data
A B C D E F G H I
123 more info more info Brown Black Red Purple
456 other stuff other stuff Orange White Yellow


I need it to look like this
A B C D E F
123 more info more info Brown
123 more info more info Black
123 more info more info Red
123 more info more info Purple
456 other stuff other stuff Orange
456 other stuff other stuff White
456 other stuff other stuff Yellow


Also, with some of my attempts. I have gotten the data to paste but
some of it has #value! in the cell instead of data. This is happening
on the cells with a lot of data.

Any assistance would be greatly appriciated

Thanks,
-KIM-
 
D

Dave Peterson

One way:

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim iRow As Long
Dim oRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Dim RngToCopy As Range
Dim HowMany As Long

Set CurWks = Worksheets("sheet1")
Set NewWks = Worksheets.Add

With CurWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

oRow = 1
For iRow = FirstRow To LastRow
Set RngToCopy = .Range(.Cells(iRow, "F"), _
.Cells(iRow, .Columns.Count).End(xlToLeft))
HowMany = RngToCopy.Cells.Count

NewWks.Cells(oRow, "A").Resize(HowMany, 5).Value _
= .Cells(iRow, "A").Resize(1, 5).Value

NewWks.Cells(oRow, "F").Resize(HowMany, 1).Value _
= Application.Transpose(RngToCopy)

oRow = oRow + HowMany
Next iRow
End With

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top