ineedadedt
Board Regular
- Joined
- Jan 7, 2004
- Messages
- 163
Hi all,
I did a search but couldn't find what I was looking for. I have this macro (thanks to this board!) that is able to breakdown my sheet 1 into sheet 2.
I would like to update this macro or create a new one to do the following:
A. Currently the macro takes all the information in the highlighted column and transposes it from vertical information to horizontal. However, I need to run it multiple times as I have sometimes 40+ columns. I would like the macro to run 1 time on sheet 1 and have it breakdown the information the same way into sheet 2 with a blank row in between to show a separation in each column.
this is the macro:
Sub test()
Dim myAreas As Areas, myArea As Range
With Sheets("sheet1")
With .Range("a1", .Range("a" & Rows.Count).End(xlUp))
On Error Resume Next
Set myAreas = .SpecialCells(2).Areas
On Error GoTo 0
If myAreas Is Nothing Then Exit Sub
For Each myArea In myAreas
If (myArea.Rows.Count > 1) * (n > 0) Then
Sheets("sheet2").Cells(n,2).Resize(,myArea.Rows.Count).Value = _
Evaluate("transpose(sheet1!" & myArea.Address & ")")
Else
n = n + 1
Sheets("sheet2").Cells(n,1).Value = myArea.Value
End If
Next
End With
End With
End Sub
Any help is greatly appreciated!
Eric
I did a search but couldn't find what I was looking for. I have this macro (thanks to this board!) that is able to breakdown my sheet 1 into sheet 2.
I would like to update this macro or create a new one to do the following:
A. Currently the macro takes all the information in the highlighted column and transposes it from vertical information to horizontal. However, I need to run it multiple times as I have sometimes 40+ columns. I would like the macro to run 1 time on sheet 1 and have it breakdown the information the same way into sheet 2 with a blank row in between to show a separation in each column.
this is the macro:
Sub test()
Dim myAreas As Areas, myArea As Range
With Sheets("sheet1")
With .Range("a1", .Range("a" & Rows.Count).End(xlUp))
On Error Resume Next
Set myAreas = .SpecialCells(2).Areas
On Error GoTo 0
If myAreas Is Nothing Then Exit Sub
For Each myArea In myAreas
If (myArea.Rows.Count > 1) * (n > 0) Then
Sheets("sheet2").Cells(n,2).Resize(,myArea.Rows.Count).Value = _
Evaluate("transpose(sheet1!" & myArea.Address & ")")
Else
n = n + 1
Sheets("sheet2").Cells(n,1).Value = myArea.Value
End If
Next
End With
End With
End Sub
Any help is greatly appreciated!
Eric