Excel - vbs script

ups! det er naturligvis 12 linjer for Hr A

Hej

Det kan løses med sortering.
Sorter først på datoer, og dernæst på navne

m v  h  mads32

Hvis jeg har forstået dig ret kan denne makro klare det.

Sub Flyt()
Dim Start, Slut, x, y, z As Long
z = 1
For x = 3 To 7 ' start i linie 3 og slut i line 7
Start = Int(Cells(x, 2).Value)
Slut = Cells(x, 3).Value
For y = Start To Slut
Worksheets("Sheet2").Cells(z, 1) = y
Cells(x, 1).Copy Destination:=Worksheets("Sheet2").Cells(z, 2)
Range(Cells(x, 4), Cells(x, 6)).Copy Destination:=Worksheets("Sheet2").Cells(z, 3)
z = z + 1
Next
Next
End Sub

Hej Jens
det er jo præcist, det jeg søgte.

jeg kunne dog godt tænke mig en justering, hvis det er muligt.

1. Kan du lave, så makroen først sletter dataene fra række 2 og resten i Sheets2 fanebladet og placerer det nye i A2.

2. I stedet for at der "kopieres" fra
"For x = 3 To 7 ' start i linie 3 og slut i line 7"
så fra 2 til der ikke er flere linjer.

Kan det lade sig gøre.

en lille tilføjelse, - det tager rigtig lang tid bare at behandle 7 rækker.... :-)

Jeg har rettet makroen til, med hensyn til dine ønsker, men den er stadig ikke særlig hurtig

Sub Flyt()
Dim Start, Slut, LastRow1, LastRow2, x, y, z As Long
Application.Calculation = xlCalculationManual
LastRow1 = Range("A" & Cells.Rows.Count).End(xlUp).Row
LastRow2 = Worksheets("Sheet2").Range("A" & Cells.Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A2:A" & LastRow2).EntireRow.ClearContents
z = 2
For x = 3 To LastRow1
Start = Cells(x, 2).Value
Slut = Cells(x, 3).Value
For y = Start To Slut
Worksheets("Sheet2").Cells(z, 1) = y
Cells(x, 1).Copy Destination:=Worksheets("Sheet2").Cells(z, 2)
Range(Cells(x, 4), Cells(x, 6)).Copy Destination:=Worksheets("Sheet2").Cells(z, 3)
z = z + 1
Next
Next
Application.Calculation = xlCalculationAutomatic
End Sub

Tak for det, det virker perfekt.