[VBA / Excel 97 - 2003] Transpose maar dan anders

[Verwijderd]

Hoi,

Op mijn werk heb ik er vaak mee te maken dat ik een tabel moet transponeren. Met de standaard functionaliteit van excel is dat in principe geen probleem. Als ik echter de formules wil behouden, en dan dus de formules met relatieve celverwijzingen (omdat ik ze daarna nog door wil kunnen trekken) ipv. absolute, dan gaat dat niet. Ik heb hiervoor een macro geschreven en die werkt prima, maar als vakidioot vraag ik me af of dat niet handiger kan, of dat ik misschien de meest voor de hand liggende oplossing voor dit probleem over het hoofd zie.

De code:

Visual Basic:

Sub SuperTranspose()

Dim StartColName As String
Dim EndColName As String
Dim StartColNum As Integer
Dim EndColNum As Integer
Dim StartRowNum As Integer
Dim EndRowNum As Integer
Dim NumberOfRows As Integer
Dim NumberOfCols As Integer
Dim SourceSheet As String
Dim TargetSheet As String
Dim NextCol As Integer
Dim NextRow As Integer
Dim NewSheetName As String

    StartColName = Application.InputBox("Wat is de eerste kolom van de tabel?")
    EndColName = Application.InputBox("Wat is de laatste kolom van de tabel?")
    StartRowNum = Application.InputBox("Wat is de eerste rij van de tabel?")
    EndRowNum = Application.InputBox("Wat is de laatste rij van de tabel?")
    
    SourceSheet = ActiveSheet.Name
    StartColNum = CNumber(StartColName)
    EndColNum = CNumber(EndColName)
    NumberOfCols = EndColNum - StartColNum + 1
    NumberOfRows = EndRowNum - StartRowNum + 1
    
    Sheets.Add
    NewSheetName = Application.InputBox("Geef een naam op voor de sheet met de getransponeerde tabel")
    ActiveSheet.Name = NewSheetName
    TargetSheet = ActiveSheet.Name
    Sheets(SourceSheet).Select
    NextCol = StartColNum
    NextRow = StartRowNum
    TargetCol = 1
    TargetRow = 1
    
    For i = 1 To NumberOfCols Step 1
        
        For j = 1 To NumberOfRows Step 1
            
            Sheets(SourceSheet).Select
            Cells(NextRow, NextCol).Select
            Selection.Cut
            Sheets(TargetSheet).Select
            Cells(TargetRow, TargetCol).Select
            ActiveSheet.Paste
            NextRow = NextRow + 1
            TargetCol = TargetCol + 1
        
        Next j
        NextRow = StartRowNum
        NextCol = NextCol + 1
        TargetRow = TargetRow + 1
        TargetCol = 1

    Next i

End Sub

Weet iemand een betere manier?

PS: de functie CNUMBER dient ervoor om een kolomletter om te zetten naar het corresponderende kolomnummer

[pedorus]

Zie [Excel] Verticaal kopiëren van functies.

Behalve dat je je macro iets mooier en sneller kan maken, zie ik het dus somber in voor het algemene geval.