Question about look up

[sey]

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.

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

[/IMG]

[/IMG]hi,

[/IMG]

 

[jasonb75]

If both refer to the same cell then yes, 17 is correct, I was thinking that they would be different.

Most of it comes from a lucky guess lol.

The problem is a couple of lines above the error,

x = Z = Sheets("SETUP").Cells(xyz, 17) / Z

Should be

x = Sheets("SETUP").Cells(xyz, 17) / Z

Hopefully it's getting close now

 

[sey]

Haha Then you are a good gambler lol
Yea no ERRORS!
But still not working correctly lol....
Maybe i better send my excel to u, if you are still not tired and bored
It's much easier to guess

Anyway thank you for all your efforts!!!

If both refer to the same cell then yes, 17 is correct, I was thinking that they would be different.

Most of it comes from a lucky guess lol.

The problem is a couple of lines above the error,

x = Z = Sheets("SETUP").Cells(xyz, 17) / Z

Should be

x = Sheets("SETUP").Cells(xyz, 17) / Z

Hopefully it's getting close now

 

[jasonb75]

Where does it appear to be going wrong now?

edit:-

the line

Next bcell

needs to be moved up, it needs to be below the line

If Not (IsEmpty(bcell)) Then .....