popipipo
Meubilair
- Lid geworden
- 21 nov 2006
- Berichten
- 9.027
- Besturingssysteem
- Win11
- Office versie
- Office 365
Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
Privacywetgeving
Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.
Sub kopie2()
Dim j As Integer
Sheets("Blad2").Rows("6:100").ClearContents
For Each cl In Range("A5:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For j = 1 To cl.Value
Cells(cl.Row, 6).Resize(, 4).Copy
Sheets("blad2").Range("c65000").End(xlUp).Offset(1).Resize(, 4).PasteSpecial Paste:=xlPasteValues
Next
Next
End Sub
Sub kopie()
Dim i As Integer
Application.ScreenUpdating = False
Sheets("Blad2").Rows("6:100").ClearContents
rij = 5
With Sheets("Blad1")
For regel = 5 To .Range("A21").End(xlUp).Row
For i = 1 To .Cells(rij, 1)
.Range(.Cells(rij, 6), .Cells(rij, 9)).Copy
Sheets("blad2").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Next i
rij = rij + 1
Next regel
End With
Application.ScreenUpdating = True
End Sub
Sub kopie2()
Dim j As Integer
Sheets("Blad2").Range("C6:F" & Cells(Rows.Count, 3).End(xlUp).Row).ClearContents
With Sheets("Blad1")
For Each cl In .Range("A5:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
For j = 1 To cl.Value
Sheets("Blad2").Range("C65000").End(xlUp).Offset(1) _
.Resize(, 4) = .Cells(cl.Row, 6).Resize(, 4).Value
Next
Next
End With
End Sub
Sub kopie2()
Dim j As Integer
Sheets("Blad2").Rows("6:100").ClearContents
Application.ScreenUpdating = False
For Each cl In Range("C5:C" & Cells(Rows.Count, 3).End(xlUp).Row)
If cl.Offset(, -2) = "" Then MsgBox "Vul aantal in ": Exit Sub
For j = 1 To cl.Offset(, -2).Value
Sheets("blad2").Range("C65000").End(xlUp).Offset(1).Resize(, 4).Value = Cells(cl.Row, 6).Resize(, 4).Value
Next j
Next cl
Application.ScreenUpdating = True
End Sub
Sub kopie()
Dim i As Integer
Application.ScreenUpdating = False
Sheets("Blad2").Rows("6:100").ClearContents
rij = 5
With Sheets("Blad1")
For regel = 5 To .Range("A21").End(xlUp).Row
If Cells(rij, 1) = "" Then
MsgBox ("Aantal invullen in cel " & "A" & rij)
Exit Sub
End If
For i = 1 To .Cells(rij, 1)
.Range(.Cells(rij, 6), .Cells(rij, 9)).Copy
Sheets("blad2").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Next i
rij = rij + 1
Next regel
End With
Application.ScreenUpdating = True
End Sub
Een beetje flauwe opmerking als ik duidelijk aangeef voor de oplossing van Warme bakkertje ga.Ik heb de aanpassing gedaan, natuurlijk in mijn codevoorstel.
With Sheets("Blad1")
For regel = 5 To .Cells(.Rows.Count, 3).End(xlUp).Row
If IsNumeric(.Cells(rij, 1)) = False Or IsEmpty(.Cells(rij, 1)) = True Then
.Cells(rij, 1) = InputBox("Aantal invullen in cel " & "A" & rij)
End If
With Sheets("Blad1")
For regel = 5 To .Range("A21").End(xlUp).Row
If Cells(rij, 1) = "" Then
MsgBox ("Aantal invullen in cel " & "A" & rij)
Exit Sub
End If
Sub kopie2()
Dim j As Integer, cl As Range
With Sheets("Blad2")
.Range("C6:F" & Application.WorksheetFunction.Max(.Cells(.Rows.Count, 3).End(xlUp).Row, 6)).ClearContents
End With
With Sheets("Blad1")
For Each cl In .Range("A5:A" & .Cells(Rows.Count, 3).End(xlUp).Row)
If IsNumeric(cl.Value) = False Or IsEmpty(cl.Value) = True Then
cl.Value = Application.InputBox("Aantal invullen in cel " & "A" & cl.Row, Type:=1)
If cl.Value = False Then cl.Value = "": GoTo Gadoor:
End If
For j = 1 To cl.Value
Sheets("Blad2").Range("C65000").End(xlUp).Offset(1) _
.Resize(, 4) = .Cells(cl.Row, 6).Resize(, 4).Value
Next
Gadoor:
Next
End With
With Sheets("Blad2")
.Select
End With
End Sub
Sub kopie()
Dim j As Integer, cl As Range
[COLOR="red"]With Sheets("Blad2")
If .[C6] <> "" Then .Range("C6:F" & .Cells(Rows.Count, 3).End(xlUp).Row).ClearContents
End With[/COLOR]
With Sheets("Blad1")
For Each cl In .Range("A5:A" & .Cells(Rows.Count, 3).End(xlUp).Row)
If IsNumeric(cl.Value) = False Or IsEmpty(cl.Value) = True Then
cl.Value = InputBox("Aantal invullen voor :" & Chr(10) & Chr(10) & " Naam : " & Range(("f") & cl.Row) & Chr(10) & "Geb Datum : " & Range(("g") & cl.Row) & Chr(10) & " Nummer : " & Range(("H") & cl.Row))
End If
For j = 1 To cl.Value
Sheets("Blad2").Range("C65000").End(xlUp).Offset(1).Resize(, 4) = .Cells(cl.Row, 6).Resize(, 4).Value
Next
Next
End With
[COLOR="red"] Application.Goto [Blad2!A1][/COLOR]
End Sub
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.