change macro address to relative (XP)

Topic

New Reply

I have recorded a macro that will copy a cell block 2 columns X 9 rows (for example, A1:b9) then paste special transpose into cell d1. The problem is that it always goes to A1 and I would like to make it relative so that it starts at the selected cell. I have about 500 of these blocks I need to transpose and each 2X9 block has two rows between it and the next block. So… I have A1:b9, A12:B20, A23:B31, A34:B42, etc. The code for the macro is as follows and I would like to know how to make it relative. Also, is there any way to make this automatic so it will do this repeatedly until there are no more blocks with data?

Sub Transpose()
‘
‘ Transpose Macro
‘ Macro recorded 9/18/2003 by Don Sadler
‘
‘ Keyboard Shortcut: Ctrl+Shift+T
‘
Range(“A2685:B2693”).Select
Selection.Copy
Range(“D2685”).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
End Sub

Reply | Quote

Replies

Where do you want to paste the transposed data? Always to cell D1? Always three cells to the right of the selected cell? Somewhere else?

The following code will copy a range starting at the active cell and extending 9 rows by two columns and transpose that range into the range starting three cells to the right of the active cell.

    Range(ActiveCell, ActiveCell.Offset(8, 1)).Copy
    ActiveCell.Offset(0, 3).PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Reply | Quote

(Edited by Don_Sadler on 18-Sep-03 12:00. To further explain the automated repetition desired.)

I always want to transpose it three cells to the right of the selected cell. Sorry, I should have mentioned it. Your code works beautifully. Is there a way to automate it so it will continue until there is no more data?

I have added code to move the active cell to the next starting point so I can execute the macro again. This works well but each starting cell should contain the entry “Name:” without the quotes. I would like the macro to continue until the cell does not contain “Name:”

Reply | Quote

Try this. It starts at A1 and goes down 11 each time until the cell is blank.

Steve

Option Explicit
Sub TransposeList()
    Dim rng As Range
    Set rng = Range("a1")
   
    Do While rng.Cells(1, 1)  ""
        Range(rng, rng.Offset(8, 1)).Copy
        rng.Offset(0, 3).PasteSpecial Paste:=xlPasteAll, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Set rng = rng.Offset(11, 0)
    Loop
End Sub

Reply | Quote

Fantastic. Thank you.

Reply | Quote

Fantastic. Thank you.

Reply | Quote

Try this. It starts at A1 and goes down 11 each time until the cell is blank.

Steve

Option Explicit
Sub TransposeList()
    Dim rng As Range
    Set rng = Range("a1")
   
    Do While rng.Cells(1, 1)  ""
        Range(rng, rng.Offset(8, 1)).Copy
        rng.Offset(0, 3).PasteSpecial Paste:=xlPasteAll, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Set rng = rng.Offset(11, 0)
    Loop
End Sub

Reply | Quote

(Edited by Don_Sadler on 18-Sep-03 12:00. To further explain the automated repetition desired.)

I always want to transpose it three cells to the right of the selected cell. Sorry, I should have mentioned it. Your code works beautifully. Is there a way to automate it so it will continue until there is no more data?

I have added code to move the active cell to the next starting point so I can execute the macro again. This works well but each starting cell should contain the entry “Name:” without the quotes. I would like the macro to continue until the cell does not contain “Name:”

Reply | Quote

Where do you want to paste the transposed data? Always to cell D1? Always three cells to the right of the selected cell? Somewhere else?

The following code will copy a range starting at the active cell and extending 9 rows by two columns and transpose that range into the range starting three cells to the right of the active cell.

    Range(ActiveCell, ActiveCell.Offset(8, 1)).Copy
    ActiveCell.Offset(0, 3).PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Reply | Quote