Afbryd makro, hvis celler er tomme

Prøv:

    Dim CountValues  As Variant
    CountValues = Application.WorksheetFunction.CountA(Range("F2:F10000"))
    If CountValues = 0 Then Exit Sub

Hej Store-morten

Den virker delvist, men ikke helt efter hensigten. - Min makro overfører stadig data, hvis bare en af celler i F2:F10000 er udfyldt.

Hensigten er at den skal kun overfører data, såfremt en person har "godkendt" de registreringer som er i A2:E10000, hvilket gøres med initialer.

Jeg tror det er en IF funktion, som jeg ikke er dygtig nok til at lave..

Prøv at vise din kode

Sub Overfør_Tidsregisteringer_Backup_Salary()

'      Kopiering af registreringer til samlet backup

'      oplåsning af Raw data - Kode PSI personlig

Sheets("Raw").Unprotect "xxxxx"

'      Test af afbrydelse af Makro, hvis der mangler godkendelse

'      Kopiering af Data til samlet backup

Sheets("Ark2").Select
Range("A2:A10000").Select
Selection.Copy
Sheets("Raw").Select
Range("A1:A10000").Find(Empty, LookIn:=xlValues).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Sheets("Ark2").Select
Range("B2:B10000").Select
Selection.Copy
Sheets("Raw").Select
Range("B1:B10000").Find(Empty, LookIn:=xlValues).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
       
Sheets("Ark2").Select
Range("C2:C10000").Select
Selection.Copy
Sheets("Raw").Select
Range("C1:C10000").Find(Empty, LookIn:=xlValues).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
       
Sheets("Ark2").Select
Range("D2:D10000").Select
Selection.Copy
Sheets("Raw").Select
Range("D1:D10000").Find(Empty, LookIn:=xlValues).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
       
Sheets("Ark2").Select
Range("E2:E10000").Select
Selection.Copy
Sheets("Raw").Select
Range("E1:E10000").Find(Empty, LookIn:=xlValues).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
       
Sheets("Ark2").Select
Range("F2:F10000").Select
Selection.Copy
Sheets("Raw").Select
Range("F1:F10000").Find(Empty, LookIn:=xlValues).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Det er lykkedes mig få den til at afbryde makroen hvis ET celle ikke er udfyldt korrekt, problemet opstår når det er en lang række celler.

For at afbryde makroen ved en celle der ikke er udfyldt har jeg brugt denne kode

Dim rCell As Range
Set rCell = Range("D4")

If IsEmpty(rCell) Then

    MsgBox "Udfyld Venligst medarbejder navn"
   
    Exit Sub
       
End If

Kan ikke få din kode til at køre!