Kopier og transponer

Udfordring: Cellerne i et bestemt område i en kolonne i Ark1, her C4:C16 skal kopieres og indsættes i D4:P4 i Ark2. Står der allerede noget i D4:P4 i Ark2, skal data indsættes i den første tomme række under denne.

Dette kan gøres med denne makro

Sub KopierOgTransponer()
    Sheets("Ark1").Range("m4:m16").Copy
    Sheets("Ark2").Select
    Range("d4").Select
    Do Until IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub
 

Først kopiers området i Ark1. Så skiftes til Ark2, for at gøre det muligt at aktivere D4 i dette ark. Forsøger man at slå de to linjer sammen til 

Sheets(Ark2").Range("d4").Select

vil denne linje muligvis virke første gang, men ellers fejle med en Runtime error 1004 "Metoden Select for klassen Range mislykkedes." Vælger man derimod arket først, vil det virke.

Loopet undersøger om den aktive celle, i første omgang D4 er tom. I modsat fald flyttes til næste række, som derefter undersøges og så fremdeles til der mødes en celle i D-kolonnen, der er tom.

I den første tomme celle indsættes det udklippede så i transponeret form, hvilket betyder at de udklippede celler nu indsættes i en række og ikke i en kolonne.