Konvertere matrix7array til rækker.

Hvis du indsætter overskrifterne i H1,I1,J1,K1,L1
Navn    Initialer    Hold    Måned    Værdi

og disse formler i række 2 og kopiere ned med fyldhåndtag

H2=FORSKYDNING($A$2;RÆKKE(5:5)/3-1,5;0)
I2=FORSKYDNING($B$2;RÆKKE(5:5)/3-1,5;0)
J2=FORSKYDNING($C$2;RÆKKE(5:5)/3-1,5;0)
K2=HVIS(K1="Måned";$D$1;HVIS(K1=$D$1;$E$1;HVIS(K1=$E$1;$F$1;HVIS(K1=$F$1;$D$1))))
L2=INDIREKTE(TEGN(ABS((RUND.OP(RÆKKE(1:1)/3;0)-RÆKKE(3:3)/3)*3)+68)&RUND.OP(RÆKKE(1:1)/3;0)+1)

Hej excelent. Du har hjulpet mig før. Kan du hjælpe mig igen? Jeg har oprettet et spørgsmål angående problemer med makro og navneskift på excelfil. Undskyld denne måed jeg henvender mig på.

Der ser fint ud, men der kommer flere måneder på hen ad vejen, så er lidt begrænset der. Er der en anden måde?

ja så skal der andre boller på suppen :-)

Sub Flyt()
Dim rng As Range
Set sh1 = Sheets("Ark1")
Set sh2 = Sheets("Ark2")
rk1 = sh1.Cells(8000, "A").End(xlUp).Row
mdr = Application.CountA(sh1.Range("D1:IV1"))
sh2.Range("A1") = "Navn": sh2.Range("B1") = "Initialer"
sh2.Range("C1") = "Hold": sh2.Range("D1") = "Måned": sh2.Range("E1") = "Værdi"
sh2.Range("A2:E8000") = "" ' sletter data i Ark2 inden nye skrives

For t = 2 To rk1
For m = 1 To mdr
rk2 = sh2.Cells(8000, "A").End(xlUp).Row + 1
sh1.Cells(t, 1).Copy sh2.Cells(rk2, 1)
sh1.Cells(t, 2).Copy sh2.Cells(rk2, 2)
sh1.Cells(t, 3).Copy sh2.Cells(rk2, 3)
Next
Next

For t = 2 To rk1

sh1.Range(Range(Cells(1, 4), Cells(1, mdr + 3)).Address).Copy
Set rng = sh2.Range("D8000").End(xlUp).Offset(1, 0)
rng.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
sh1.Range(Range(Cells(t, 4), Cells(t, mdr + 3)).Address).Copy
Set rng = sh2.Range("E8000").End(xlUp).Offset(1, 0)
rng.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False

Next
ActiveCell.Select
End Sub

hvordan går det ?

?

Hej, har fundet et problem. Hvis et af månedsværdierne er tomme, så går det helt galt.

Er der en måde at rette op det?