Makro för att loopa igenom celler och kopiera innehåll

[AniN]

Hej.

 

Har suttit i evigheter för att försöka lösa mitt problem men har fastnat helt och vet inte ens längre var jag ska börja…

 

Jag ska göra ett bemanningsschema och har underlaget i kolumnerna A-F på bladet ”Fakta”. Jag vill skapa ett makro som loopar igenom C2:G6, rad för rad, och utifrån respektive cells värde kopiera information till bladet ”Schema” det antal gånger som värdet i cellen anger, dvs. 4 ggr enligt C2, 3 ggr enligt D2 osv. Informationen ska kopieras enligt följande:

A10 till Kolumn A

A2, A3, A4 osv. till Kolumn B

B2, B3, B4 osv. till Kolumn C

C1, D1, E1 osv. till Kolumn D

 

Resultatet ska se ut som i bifogat exempel.

 

Någon som kan hjälpa mig?

[MickeF]

Sub SkapaSchema()
    Dim dataRad%, dataKol%, printRad%, ant%
    With Sheets(1)
        dataRad = 2
        printRad = 2
        ' Alla rader fram till tom cell
        Do Until IsEmpty(.Cells(dataRad, 1))
            dataKol = 3 ' Hämta antal i kolumn C
            ' Alla kolumner fram till tom cell
            Do Until IsEmpty(.Cells(dataRad, dataKol))
                For ant = 1 To .Cells(dataRad, dataKol)
                    Sheets(2).Cells(printRad, 1) = .Cells(10, 1)        ' Datum
                    Sheets(2).Cells(printRad, 2) = .Cells(dataRad, 1)   ' Intervall
                    Sheets(2).Cells(printRad, 3) = .Cells(dataRad, 2)   ' Min
                    Sheets(2).Cells(printRad, 4) = .Cells(1, dataKol)   ' Enhet
                    printRad = printRad + 1
                Next
                dataKol = dataKol + 1
            Loop
            dataRad = dataRad + 1
        Loop
    End With
    ' Rensa i slutet
    Do Until IsEmpty(Sheets(2).Cells(printRad, 1))
        Sheets(2).Cells(printRad, 1) = Null
        Sheets(2).Cells(printRad, 2) = Null
        Sheets(2).Cells(printRad, 3) = Null
        Sheets(2).Cells(printRad, 4) = Null
        printRad = printRad + 1
    Loop
End Sub

 

[MickeF]

1 timme sedan, MH_resurrected säger:

Dessutom kan du kolla om du får samma resultat  (om du tar bort -3 på rad 11).

 

Tack den där debug-biten glömde jag ta bort
Nu är det redigerat.

[AniN]

Tack! Har nu testat era lösningar och båda fungerar flawless! Grymt tacksam för er hjälp