Ga naar inhoud

Excel vba macro om rijen te kopiëren gebaseerd op de waarde van een cell


Dalbos

Aanbevolen berichten

Omdat het niet mogelijk is mijn vorig bericht te wijzigen of verwijderen, een neiuw bericht om een aangepaste code te kunnen plaatsen. Verder nog twee opmerkingen:

1. In het invulblad heb je vanaf rij 9  de kolommen A en B in ALLE rijen (dat zijn meer dan 1 miljoen rijen) groen gemaakt, hierdoor wordt je bestand 40 keer zo groot als wanneer je dat niet had gedaan. Het is niet verstandig van veel meer rijen gebruik te maken dan je nodig hebt.

2. Verder heb je in het invulblad twee rijen geplaatst die identiek zijn aan een andere rij. Voor de macro maakt dat niets uit, maar als je dat niet weet kan het resultaat anders zijn dan je had gedacht. Daar rekening mee houdend, doet de macro wat je wil.

Sub kopieer()
Dim a As Integer, p As Integer, q As Integer, x As Integer
Application.ScreenUpdating = False
Sheets("Verveelvoudiging").Cells.ClearContents
With Sheets("Invulblad")
p = .Range("a1").CurrentRegion.Rows.Count
q = WorksheetFunction.Match("", .Range("c1:c" & p), 0) - 1
.Range("c1:p" & q).Copy
End With
With Sheets("Verveelvoudiging")
.Activate
With .Range("a1")
.PasteSpecial Paste:=xlPasteValues
.Select
End With
x = q
Do While x > 1
a = .Range("c" & x).Value
If a > 1 Then
.Rows(x + 1 & ":" & x + a - 1).Insert
.Rows(x & ":" & x + a - 1).FillDown
End If
x = x - 1
Loop
.Columns("a:n").AutoFit
End With
Application.ScreenUpdating = True
End Sub

Link naar reactie
Delen op andere sites

×
×
  • Nieuwe aanmaken...

Belangrijke informatie

We hebben cookies geplaatst op je toestel om deze website voor jou beter te kunnen maken. Je kunt de cookie instellingen aanpassen, anders gaan we er van uit dat het goed is om verder te gaan.