Riportare scadenze documenti personali

Sub AggiornaFoglio3()
Dim ur As Long
Dim ur1 As Long
Dim lr As Long
Dim rng As Range
Dim cel As Range
lr = Worksheets("3").Cells(Rows.Count, "L").End(xlUp).Row
Set rng = Worksheets("3").Range("L4:L" & lr)
Worksheets("SCADENZIARIO").Range("Q7:r35").ClearContents
For Each cel In rng
    If cel.Value = "In scadenza" Then
        ur = Worksheets("SCADENZIARIO").Cells(Rows.Count, "q").End(xlUp).Row
        Worksheets("SCADENZIARIO").Cells(ur + 1, "q").Value = cel.Offset(0, -8).Value
        ElseIf cel.Value = "Scaduta" Then
        ur1 = Worksheets("SCADENZIARIO").Cells(Rows.Count, "r").End(xlUp).Row
        Worksheets("SCADENZIARIO").Cells(ur1 + 1, "r").Value = cel.Offset(0, -8).Value
    End If
Next cel
End Sub

Sub AggiornaFoglio4()
Dim ur As Long
Dim ur1 As Long
Dim lr As Long
Dim rng As Range
Dim cel As Range
lr = Worksheets("4").Cells(Rows.Count, "W").End(xlUp).Row
Set rng = Worksheets("4").Range("W4:W" & lr)
Worksheets("SCADENZIARIO").Range("S7:T35").ClearContents
For Each cel In rng
    If cel.Value = "In scadenza" Then
        ur = Worksheets("SCADENZIARIO").Cells(Rows.Count, "s").End(xlUp).Row
        Worksheets("SCADENZIARIO").Cells(ur + 1, "s").Value = cel.Offset(0, -19).Value
        ElseIf cel.Value = "Scaduta" Then
        ur1 = Worksheets("SCADENZIARIO").Cells(Rows.Count, "t").End(xlUp).Row
        Worksheets("SCADENZIARIO").Cells(ur1 + 1, "t").Value = cel.Offset(0, -19).Value
    End If
Next cel
End Sub

Sub AggiornaFoglio5()
Dim ur As Long
Dim ur1 As Long
Dim lr As Long
Dim rng As Range
Dim cel As Range
lr = Worksheets("5").Cells(Rows.Count, "j").End(xlUp).Row
Set rng = Worksheets("5").Range("j4:j" & lr)
Worksheets("SCADENZIARIO").Range("U7:v35").ClearContents
For Each cel In rng
    If cel.Value = "In scadenza" Then
        ur = Worksheets("SCADENZIARIO").Cells(Rows.Count, "u").End(xlUp).Row
        Worksheets("SCADENZIARIO").Cells(ur + 1, "u").Value = cel.Offset(0, -7).Value
        ElseIf cel.Value = "Scaduta" Then
        ur1 = Worksheets("SCADENZIARIO").Cells(Rows.Count, "v").End(xlUp).Row
        Worksheets("SCADENZIARIO").Cells(ur1 + 1, "v").Value = cel.Offset(0, -7).Value
    End If
Next cel
End Sub

Sub AggiornaFoglio6()
Dim ur As Long
Dim ur1 As Long
Dim lr As Long
Dim rng As Range
Dim cel As Range
lr = Worksheets("6").Cells(Rows.Count, "k").End(xlUp).Row
Set rng = Worksheets("6").Range("k4:k" & lr)
Worksheets("SCADENZIARIO").Range("w7:w35").ClearContents
For Each cel In rng
    If cel.Value = "Da consegnare" Then
        ur = Worksheets("SCADENZIARIO").Cells(Rows.Count, "w").End(xlUp).Row
        Worksheets("SCADENZIARIO").Cells(ur + 1, "w").Value = cel.Offset(0, -8).Value
    End If
Next cel
End Sub

Sub AggiornaTutto()
    Call AggiornaFoglio4
    Call AggiornaFoglio5
    Call AggiornaFoglio6
End Sub