Problemen met het maken van een loop

[Hansie86]

Hallo,

ik ben bezig met het maken van een tool die een weekplanning zou kunnen maken. Hierin lukt het wel om de eerste loop te verwerken en goed uit te voeren maar bij de 2e loop lukt dat niet.
Hieronder het stuk vanaf de 1e loop tot en met de 2e loop die dus fout gaat.

For Each huidigecel In Range("L2:L150")
If (Val(huidigecel.Value)) < -1000 Then huidigecel.ClearContents
Next

' Uren berekenen --------------------------------------------------------------------

Range("I2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-3]"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I149"), Type:=xlFillDefault
Range("I2:I150").Select


' Zoeken naar duur van productie ---------------------------------------------------

Range("H2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Code!R1C1:R50C3,3,FALSE)"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H150"), Type:=xlFillDefault
Range("H2:H150").Select

ActiveWorkbook.Worksheets("Planningformat").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Planningformat").AutoFilter.Sort.SortFields.Add Key _
:=Range("L1:L150"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Planningformat").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

' Loop voor het maken van weekplanning ----------------------------------------------


Sheets("Weekplanning").Select
ActiveCell.FormulaR1C1 = "=SUM(R[3]C[3]:R[1048572]C[3])"
Range("E4").Select

For Each Order In Range("A7:A50")
If Cells(4, 5).Value > Cells(2, 4).Value Then
Sheets("Planningformat").Select
Rows("2:2").Select
Selection.Cut
Sheets("Weekplanning").Select
Range("A7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Planningformat").Select
Selection.Delete Shift:=xlUp
Sheets("Weekplanning").Select
End If
Next

Het probleem zit em in ''For Each Order In Range("A7:A50")'' althans dat is de foutmelding vanuit VBA.
Zou iemand kunnen kijken wat hier nou fout gaat?

Gr

 

[HSV]

Misschien kun je beter het bestand plaatsen zonder gevoelige info en aan de hand daarvan een beschrijving geven wat je wilt bereiken.
Select en Selection zijn overbodig in zulke codes.

 

[Hansie86]

Hetgeen wat ik wil bereiken is dat vanuit sheet 2 genaamd 'formatplanning' elke keer een regel gekopieerd wordt naar de eerste sheet 'weekplanning', waarin de regel geplakt wordt in regel 7
dus 'formatplanning' 2;2 naar 'weekplanning' 7;7.

dan zou je dus de volgende reeks krijgen:
2;2 -> 7:7
3;3 -> 8:8
4:4 -> 9:9
enzovoort


ik wil dat dit net zolang gebeurt totdat de som van kolom H (wordt automatisch ingevoerd in E4) gelijk is of groter is dan B4. Dan moet de loop stoppen.
Alle regels zijn qua format al gelijk dus daar hoeft alleen geknipt en geplakt te worden.

 

[HSV]

Dat kan met "While", "Wend".

Ik lees cel E4 en B4 en kolom H, maar van welk blad wet ik nog niet.
Vandaar de vraag naar een voorbeeldbestand, dat hoeft dus niet het echte bestand te zijn.

 

[VenA]

Een macro-opname plaatsen is wel een begin maar dan graag tussen codetags. Een voorbeeldbestand er bij doen is nog beter want hoe moeten de helpers weten wat de activecell is? Order is een gereserveerd woord binnen VBA dus mogelijk dat dat de boosdoener is. In #3 heb je het over sheet 'formatplanning' terwijl er in de code Sheets("Planningformat") staat. Volgens mij heb je geen lus nodig en kan je het zo eens proberen.

Sub VenA()
  With Sheets("Weekplanning")
    .Range("E3") = "=SUM(R[3]C[3]:R[1048572]C[3])"
    If .Cells(4, 5) > .Cells(2, 4) Then
      Sheets("Planningformat").Rows(2).Resize(.Cells(4, 5).Value - .Cells(2, 4).Value).Cut
      .Range("A7").Insert
    End If
  End With
End Sub

 

[Hansie86]

Bijgevoegd de upload, over alle invoer wordt gesproken over het eerste tabbblad, uit het 2e tabblad zou alle input moeten zijn voor het eerste tabblad.
Het probleem zit em in het stuk onder 'loop voor de weekplanning'. Alles daarboven werkt prima.

 

[VenA]

Probeer het zo eens.

Sub VenA()
  Sheets("Weekplanning").[E3] = Date
  With Sheets("Planningformat")
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("H2:H" & lr).FormulaR1C1 = "=VLOOKUP(RC[-1],Code!R1C1:R50C3,3,FALSE)"
    .Range("L2:L" & lr).FormulaR1C1 = "=RC[-1]-Weekplanning!R3C5"
    .Range("I2:I" & lr).FormulaR1C1 = "=RC[-1]*RC[-3]"
    .Cells(1).CurrentRegion.Sort .[L1], , , , , , , xlYes
    For j = 2 To lr
      t = t + .Cells(j, 9)
      If t > Sheets("Weekplanning").[B4] Then Exit For
    Next j
    .Rows(2).Resize(j - 2).Cut Sheets("Weekplanning").[A7]
    .Rows(2).Resize(j - 2).Delete
  End With
End Sub

 

[Hansie86]

JA! met deze code werkt hij. Bedankt voor de hulp