VBA gegevens ophalen

Sub test2()
  
Dim sh As Worksheet, Po As Worksheet
Set Po = Sheets("TEST")
Dim answer As Integer

    'Veld wordt leeg gemaakt en opmaak verwijderd
       Dim opmk As Range
       On Error Resume Next
       Set opmk = Po.Columns("A:R")
       Application.ScreenUpdating = False                           'screenupdating uit
       opmk.Clear
       Application.ScreenUpdating = True

answer = MsgBox("Wilt u morgen?", vbQuestion + vbYesNo)
 
  If answer = vbYes Then
  wk = Date
  Else
    wk = InputBox("Vul datum in")
    If wk <> "" Then
  End If

        'Zoekterm wordt gezocht in array sheets
        For Each sh In Sheets(Array("Blad1", "Blad2", "Blad3", "Blad4"))
            If sh.Name <> Po.Name Then
                With sh.Cells(4, 1).CurrentRegion
                    .AutoFilter 5, Criteria1:="<>0"
                    .AutoFilter 14, wk
                    If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then    'er zijn nog gefilterde gegevens overgebleven
                        .SpecialCells(xlCellTypeVisible).Copy        'gefilterde gegevens kopieren
                        Po.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                    End If
                    .AutoFilter
                End With
            End If
        Next sh
        With Po.Cells
            .WrapText = False
            .MergeCells = False
        End With
        Application.GoTo Sheets("TEST").Range("A1"), 1
    End If
    'End If
    
    Columns("C:C").NumberFormat = "dd/mm/yyyy"
    Columns("N:N").NumberFormat = "dd/mm/yyyy"
    
End Sub

Sub VenA()
  If MsgBox("Wilt u morgen?", vbQuestion + vbYesNo) = vbYes Then
    Application.ScreenUpdating = False
    Sheets("Test").UsedRange.Clear
    For Each sh In Sheets(Array("Blad1", "Blad2", "Blad3", "Blad4"))
      With sh.Cells(1).CurrentRegion
        .AutoFilter 5, "<>0"
        .AutoFilter 14, 3, 11
        x = Abs(Sheets("Test").Cells(1).Value <> "")
        .Offset(x).Copy Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(x)
        .AutoFilter
      End With
    Next sh
  End If
End Sub