Hi
I have a question for looping.
This is all my code, and ("eersterij") means firstrow. In first row he find all dimensions. u can see on the first image, firstrow is selected, second row is the row under first row and finally there is a third row under second row. (But there can be more rows)
Here you see my code:
In the images u see:
First he is looking for how many rows there are ( now there are 3 rows).
Then he paste the dimensions from the first row in a template (you can see in the second picture).
Then he paste the template in a worksheet.
Then he cleans the dimensions in the template and he copy this template 2 times more.
You can see in the last picture : 3 rows with dimensions, so 3 pictures of a template.
But what i want is this:
First he copy the dimensions from the first row in the template and paste the template in that other worksheet. ( then he cleans the dimenions in the original template)
THEN he copy the dimensions of the SECOND row and paste them in the original template and paste the template under the second one in a new worksheet.( then he cleans the dimenions in the original template)
THEN the third one.
(IF there are more rows then ofcourse for fourth, fifth... row too.)
The code :
For Each acell In Range("eersterij")
If acell.Value > 0 Then
acell.copy
y = acell.Value / x
I need to write something other in place of ("eersterij") , so he goes to the second row and third row too, without writing this code 3 times.
[/IMG]
[/IMG]hi,
[/IMG]
I have a question for looping.
This is all my code, and ("eersterij") means firstrow. In first row he find all dimensions. u can see on the first image, firstrow is selected, second row is the row under first row and finally there is a third row under second row. (But there can be more rows)
Here you see my code:
In the images u see:
First he is looking for how many rows there are ( now there are 3 rows).
Then he paste the dimensions from the first row in a template (you can see in the second picture).
Then he paste the template in a worksheet.
Then he cleans the dimensions in the template and he copy this template 2 times more.
You can see in the last picture : 3 rows with dimensions, so 3 pictures of a template.
But what i want is this:
First he copy the dimensions from the first row in the template and paste the template in that other worksheet. ( then he cleans the dimenions in the original template)
THEN he copy the dimensions of the SECOND row and paste them in the original template and paste the template under the second one in a new worksheet.( then he cleans the dimenions in the original template)
THEN the third one.
(IF there are more rows then ofcourse for fourth, fifth... row too.)
The code :
For Each acell In Range("eersterij")
If acell.Value > 0 Then
acell.copy
y = acell.Value / x
I need to write something other in place of ("eersterij") , so he goes to the second row and third row too, without writing this code 3 times.
Code:
Sub copypastelookupalin1()
Dim acell As Range
Dim teller As Integer
Dim y As Double
Dim bcell As Range
Dim counter As Integer
counter = 0
teller = 0
' kijken hoeveel keer een template moet gemaakt worden
Sheets("SETUP").Activate
Range("begincellll").Select
ActiveCell = ActiveCell.Offset(1, 1)
For Each bcell In Range("Bereik")
If IsEmpty(bcell) Then
'bcell = blank
Else: 'bcell = 1
counter = counter + 1
' maak een cel om te starten
Sheets("kwnie").Activate
Range("D20").Name = "afmt100"
' bereken het aantal cellen die nodig zijn
Z = Range("totalelengte2") / 100
'bereken de schaal
a = Z / 83
' de afstand die 1 cel zal bevatten
Sheets("SETUP").Activate
Range("totalelengte2").Select
x = Range("totalelengte2").Value / Z
For Each acell In Range("eersterij")
If acell.Value > 0 Then
acell.copy
y = acell.Value / x
Sheets("kwnie").Activate
Range("afmt100").Activate
'ActiveCell.Value = "|"
ActiveCell.Offset(0, Round(teller + y / 2)).Select
teller = teller + y
ActiveSheet.PasteSpecial
End If
Next acell
' afbeelding aanpassen aan de schaal
ActiveSheet.Shapes("afbeeldingg").Select
ActiveSheet.Shapes("afbeeldingg").Delete
Sheets("stuktekening gordingenang").Select
ActiveSheet.Shapes("object 1").copy
Sheets("kwnie").Select
Range("A24").Select
ActiveSheet.Paste
Selection.Name = "afbeeldingg"
ActiveSheet.Shapes("afbeeldingg").Select
Application.CutCopyMode = False
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.ScaleHeight a, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth a, msoFalse, msoScaleFromTopLeft
' cellen opmaken voor waarden mooi in te plaatsen
Range("voorbeeld").Select
Selection.copy
Range("invulplaatsen").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
' templates kopieren en onder elkaar polaatsen
Sheets("kwnie").Activate
Range("Print_Area").CopyPicture
Sheets("Stuktekeningtemplate").Activate
Range("startcel").Select
ActiveCell.Offset(((counter - 1) * 50) + 1, 0).Select
ActiveSheet.PasteSpecial
' cellen legen voor volgende copy
Sheets("kwnie").Activate
Range("invulplaatsen").Select
Selection.ClearContents
End If
Next bcell
Sheets("SETUP").Activate
Range("begincellll").Select
ActiveCell.FormulaR1C1 = counter
End Sub
