PDA

View Full Version : Transpose Horizontal Table



omegaboost
07-11-2016, 03:37 AM
Dear All,

I need help to make the VBA script for transpose the horizontal excel table (Sheet "database") into table in sheet "Cnrt Table". I try to do with copy and paste special but it takes time and not effective.

Thank you

Best Regards

Omegaboost

offthelip
07-12-2016, 08:59 AM
try this:

Sub movedata()
Dim datar As Variant


With Worksheets("Cnrt Table")
headings = .Range("a5:o5")
End With
With Worksheets("database")
dbheads = .Range("a1:ge1")
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
End With
For i = 1 To 15
For j = 1 To 187
If headings(1, i) = dbheads(1, j) Then
'copy to column i
Worksheets("database").Activate
Worksheets("database").Range(Cells(2, j), Cells(lastrow, j)).Copy Worksheets("Cnrt Table").Cells(6, i)
Exit For
End If
Next j
Next i


End Sub

omegaboost
07-13-2016, 09:35 AM
Dear offthelip,

Thank you for your reply but i got error on this part "Worksheets("database").Range(Cells(2, j), Cells(lastrow, j)).Copy Worksheets("Cnrt Table").Cells(6, i)".
Is there any solution for this error?

Thank you
Omegaboost

mdmackillop
07-13-2016, 09:51 AM
This line should be as follows to include a missing qualifier

lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row

Also I'd tweak it slightly as follows to omit the sheet activation

Sub movedata()
Dim datar As Variant
With Worksheets("Cnrt Table")
headings = .Range("a5:o5")
End With
With Worksheets("database")
dbheads = .Range("a1:ge1")
lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row
For i = 1 To 15
For j = 1 To 187
If headings(1, i) = dbheads(1, j) Then
'copy to column i
Range(.Cells(2, j), .Cells(lastrow, j)).Copy Worksheets("Cnrt Table").Cells(6, i)
Exit For
End If
Next j
Next i
End With
End Sub

offthelip
07-13-2016, 11:10 AM
@omega
What I have found interesting is that I am running Excel 2007 and the "lastrow" variable was set correctly inspite of my typo in missing the dot !!
So I didn't get the error. I presume you are running a more recent version.

@mdmackillop A good modification to reduce what is in the loop to a minimum

mdmackillop
07-13-2016, 11:31 AM
@Offthelip
The error arises if you run the code from the "other" worksheet, in which case LastRow has that sheet value.

omegaboost
07-14-2016, 03:29 AM
Dear offthelip
Dear mdmackillop

Thank you for your help. I already try the VBA and it is work only if run in the same worksheet. What about if i want to run it from other worksheet?

Once again, thank you in advance

Regards

Omegaboost

snb
07-14-2016, 03:58 AM
Sub M_snb()
sn = Sheet9.Cells(1).CurrentRegion

With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
For jj = 8 To 27
If sn(j, jj) = "" Then Exit For
.Item(.Count) = Array(sn(j, 2), sn(j, 3), sn(j, 4), sn(j, 5), sn(j, 6), sn(j, 7), sn(j, jj), sn(j, 28), sn(j, 48), sn(j, 68), sn(j, 88), sn(j, 108))
Next
Next
Sheet1.Cells(20, 1).Resize(.Count, 12) = Application.Index(.items, 0, 0)
End With
End Sub

mdmackillop
07-14-2016, 04:00 AM
The code in Post #4 runs from any sheet.