Urgent--macro for transposing data

[HUZZAIN]

Hi there,

Im trying to create a Macro which can do the following: Start selecting from a1 till blank column and coming down till blank row cell by cell , select the all above values, copy them and paste them by transposing them AFTER tWo blank columns, carry on doing this procedure and pasting the transposed values . Can you please help me with this Macro. Help will be greatly appreciated.
eg;
columnA columnB blank column blank column[TABLE="width: 320"]
<colgroup><col width="64" span="5" style="width: 48pt;"></colgroup><tbody>[TR]
[TD="width: 64"][/TD]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl66, width: 64"][/TD]
[TD="class: xl67, width: 64"][/TD]
[TD="class: xl68, width: 64"][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 362"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]Demir (Serum)[/TD]
[TD]16[/TD]
[/TR]
[TR]
[TD]Demir bağlama kapasitesi[/TD]
[TD]362[/TD]
[/TR]
[TR]
[TD]Glukoz [/TD]
[TD]109[/TD]
[/TR]
[TR]
[TD]HBA1C[/TD]
[TD]5,6[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Demir (Serum)[/TD]
[TD]41[/TD]
[/TR]
[TR]
[TD]Demir bağlama kapasitesi[/TD]
[TD]215[/TD]
[/TR]
[TR]
[TD]Ferritin [/TD]
[TD]56,46[/TD]
[/TR]
[TR]
[TD]Glukoz [/TD]
[TD]101[/TD]
[/TR]
[TR]
[TD]HBA1C[/TD]
[TD]5,8[/TD]
[/TR]
</tbody>[/TABLE]

transpose the data to 2nd blank column .
help will be greatly apppreciated.

 

[Caleeco]

If I understand what you need to do, this code should work

Sub Transpose()


Dim rData As Range


Set rData = ActiveSheet.Range("A1", Cells(Rows.Count, "B").End(xlUp))


rData.Copy


ActiveSheet.Range("E1").PasteSpecial Transpose:=True


End Sub

 

[HUZZAIN]

thankyou for the reply but the code is giving an error on the following line ,
ActiveSheet.Range("E1").PasteSpecial Transpose:=True
my excel is in different language,its saying that the selection is not matching the paste area.

 

[HUZZAIN]

ı guess the code is selecting whole data and transposing it thats y its giving an error of not getting the space to transpose.
suppose ı have the following data .
1 j
2 f
4 f
5 g

7 jj
8 kk
9 kk
3 uu

4 ll
6 uu
7 oo

what i want the code to do is to transpose data like below
1 2 3 5
j f f g

ı want it to copy in the column d,e,f,g,h etc with their respective value.

 

[Max1616]

Try this:

Sub Huzzain()
Dim lrow As Integer
Dim lcolumn As Integer

lrow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:B" & lrow).Copy

Cells(1, 4).PasteSpecial Transpose:=True

Nexti:
lcolumn = Cells(1, Columns.Count).End(xlToLeft).Column

For i = 4 To lcolumn
    If Cells(1, i) = "" Then
        Columns(i).Delete
        i = i - 1
        GoTo Nexti
    End If
Next i

End Sub

 

[HUZZAIN]

Thanks but i didnt work its taking all the data and transposing it
1 j
2 f
4 f
5 g

7 jj
8 kk
9 kk
3 uu

4 ll
6 uu
7 oo

what i want the code to do is to transpose data like below

1 2 3 5
j f f g

7 8 9 3
jj kk kk uu

 

[mikerickson]

Perhaps

Sub test()
    Dim oneArea As Range
    Dim oneValueSet As Variant
    Dim maxCol As Long, i As Long
    
    With Range("A:A")
        For Each oneArea In .SpecialCells(xlCellTypeConstants).Areas
            With oneArea.CurrentRegion
                If maxCol < .Rows.Count Then maxCol = .Rows.Count
                oneValueSet = .Value
                .ClearContents
                .Resize(.Columns.Count).Insert
                With .Offset(-.Columns.Count, 0)
                    .Resize(.Columns.Count, .Rows.Count).Value = Application.Transpose(oneValueSet)
                End With
            End With
        Next oneArea
        
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
            With Cells(i, 1)
                If .Value & .Offset(-1, 0) = vbNullString Then
                    .Resize(1, maxCol).Delete
                End If
            End With
        Next i
    End With
End Sub