PDA

View Full Version : [SOLVED] Vba code to transpose specific range of data from column A to another sheet



Jagdev
03-24-2015, 07:56 AM
I have the data in column A, after every sixth row there is a blank row and then the record gets repeated. I want the transpose code in vba which will reflect the data in a new sheet and col A, B, C, D, E and F respectively.
WC2014010123
Inc
04/08/2014
04/08/2014
Jess G
Closed 04/09/2014

WC2014010456
Inc
04/11/2014
04/15/2014
Jess G
Closed 04/16/2014

WC2014010789
Inc
04/26/2014
04/27/2014
Jess G
Closed 04/28/2014

Regards,
JD

Bob Phillips
03-24-2015, 09:24 AM
Public Sub TransposeData()
Dim lastrow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow - 5 To 1 Step -7

.Cells(i, "A").Resize(6).Copy
.Cells(i, "B").Resize(, 6).PasteSpecial Paste:=xlPasteAll, Transpose:=True
.Rows(i + 1).Resize(6).Delete
Next i

.Columns("A").Delete
End With

Application.ScreenUpdating = True
End Sub

jolivanes
03-24-2015, 10:57 PM
Or

Sub test()
Dim i As Long
For i = 1 To Columns(1).SpecialCells(2).Areas.Count
With Columns(1).SpecialCells(2).Areas(i)
Sheets("Sheet2").Cells(i, 2).Resize(, .Rows.Count).Value = Application.Transpose(.Value)
End With
Next
Columns(1).Delete
End Sub

Yongle
03-25-2015, 04:19 AM
Or looking at things from the opposite direction to XLD
Assumes data starts in cell A1 (if not, change value of x to first row with data)

Sub Transpose_Copy()
Dim x As Long, NextRow As Long
NextRow = 2
x = 1
With ActiveSheet
Do Until .Range("A" & x).Value = ""
.Range("A" & x & ":A" & x + 5).Copy
.Range("B" & NextRow & ":F" & NextRow).PasteSpecial Paste:=xlPasteAll, Transpose:=True
NextRow = NextRow + 1
x = x + 7
Loop
.Columns("A").Delete
End With
End Sub

Jagdev
03-27-2015, 06:52 AM
Hi All

Thanks for the code it really fits in my requirement.

Regards,
JD