marco (deel ervan) meermalen uitvoeren

[wim1985]

Ik heb een macro waarbij hij halve wege de macro moet kijken of de active cel leeg is. Als deze leeg is moet de rest van de macro afgemaakt worden zoniet dat moet hij weer bovenaan de macro beginnen. Hoe werkt zoiets?

Alvast bedankt

 

[Wigi]

Ik heb een macro waarbij hij halve wege de macro moet kijken of de active cel leeg is. Als deze leeg is moet de rest van de macro afgemaakt worden zoniet dat moet hij weer bovenaan de macro beginnen. Hoe werkt zoiets?

Alvast bedankt

Zoiets zet je in een lus. Bvb.

Do ... Loop Until
Do ... Loop While
Do Until... Loop
Do While ... Loop
For ... Next
For Each x In y ... Next

Wigi

 

[wim1985]

Ik kom hier niet uit. Ben de hele dag al diverse dingen aan het testen maar werkt steeds niet.
Hier mijn macro. Het werkt nu zo dat ik op de gewenste rij ga staan en dan de macro bedien. Dit gaat voor 1 rij prima, maar als er bv 50 rijen onder elkaar staan en je telkens een rij moet selecteren en de macro bedienen is dat wel tijdrovend en veel kans op fouten. De eerste rij is altijd rij 23 en zou dan de macro moeten blijven herhalen met dan rij 24 enz enz totdat hij een rij tegenkomt waarbij geen data meer staat in kolom b van die rij. Hij moet dan de macro eindigen. Zou iemand hier raad in weten?

{Sub verwerkenenprinten()

    Sheets("Werkorder").Select
    ActiveCell.EntireRow.Select
    Application.CutCopyMode = False
    Selection.Copy
    Rows("230:230").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Sheets("Printblad")
        .Range("C5").Value = Sheets("Werkorder").Range("D3").Value
        .Range("C6").Value = Sheets("Werkorder").Range("B230").Value
        .Range("C7").Value = Sheets("Werkorder").Range("C230").Value
        .Range("C9").Value = Sheets("Werkorder").Range("H230").Value
        .Range("C10").Value = Sheets("Werkorder").Range("J230").Value
        .Range("C11").Value = Sheets("Werkorder").Range("M230").Value
        .Range("C12").Value = Sheets("Werkorder").Range("N230").Value
        .Range("C13").Value = Sheets("Werkorder").Range("F230").Value
        .Range("C14").Value = Sheets("Werkorder").Range("E230").Value
        .Range("C15").Value = Sheets("Werkorder").Range("G230").Value
        .Range("C16").Value = Sheets("Werkorder").Range("D230").Value
        .Range("C17").Value = Sheets("Werkorder").Range("T230").Value
        .Range("C18").Value = Sheets("Werkorder").Range("U230").Value
        .Range("C19").Value = Sheets("Werkorder").Range("V230").Value
        .Range("C20").Value = Sheets("Werkorder").Range("S230").Value
        .Range("C21").Value = Sheets("Werkorder").Range("K230").Value
        .Range("C22").Value = Sheets("Werkorder").Range("L230").Value
    End With
    Sheets("Werkorder").Select
    Rows("230:230").ClearContents
    Range("A1").Select
    Sheets("Printblad").Select
    Columns("A:A").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("B1").Select
    Sheets("Printblad").Select
    Columns("A:A").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("B1").Select
    Range("A2:C19").Select
    Range("F2").Activate
    Sheets("Printblad").Select
    Range("A2:D19").Select
    Range("F2").Activate
    ActiveSheet.PageSetup.PrintArea = "$A$1:$D$34"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

    Dim sBestandsnaam As String
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        sBestandsnaam = .Range("C2").Value
        .Copy
    End With
    
    With ActiveWorkbook
        .SaveAs "\\Dirkjan\shareddocs\urenregistratiesysteem\kopie werkbon\" & sBestandsnaam
        .Close
    End With
    
    Application.ScreenUpdating = True

    Sheets("Verwerkte orders").Select
    Rows("2:2").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown
    With Sheets("Verwerkte orders")
        .Range("A2").Value = Sheets("Printblad").Range("C2").Value
        .Range("B2").Value = Sheets("Printblad").Range("C5").Value
        .Range("C2").Value = Sheets("Printblad").Range("C6").Value
        .Range("D2").Value = Sheets("Printblad").Range("C10").Value
        .Range("E2").Value = Sheets("Printblad").Range("C13").Value
        .Range("F2").Value = Sheets("Printblad").Range("C14").Value
        .Range("G2").Value = Sheets("Printblad").Range("C20").Value
        .Range("H2").Value = Sheets("Printblad").Range("C8").Value
        .Range("I2").Value = Sheets("Printblad").Range("C9").Value
    End With
    Columns("A:I").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Sheets("Werkorder").Select
    Range("C6").Select
  
End Sub}

 

[Wigi]

Code tags zijn

 en [/ code] (dit laatste zonder spatie in).

 

[wim1985]

Zou iemand hier nog eens naar kijken willen, oud probleem wat mij veel tijd kan sparen als het werkt.

gr Wim