Data splitsen in kwartalen

[snb]

Voor wie kolommenangst heeft; voor het bestand in #11

Sub M_snb()
  Application.DisplayAlerts = False
  y = InputBox("kwartaal", "snb")
   
  With Blad1.ListObjects(1).DataBodyRange
    .AutoFilter 1, ">=" & DateSerial(2022, 3 * (y - 1) + 1, 1) \ 1, 1, "<" & DateSerial(2022, 3 * y + 1, 1) \ 1
    .Copy
    With Sheets.Add(, Sheets(Sheets.Count))
      .Paste
      .Copy
      With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\kwartaal2.xlsx", 51
        .Close 0
      End With
      .Delete
    End With
    .AutoFilter
  End With
End Sub

 

[AD1957]

of

 With Blad1.ListObjects(1).Range
     .AutoFilter 1, 18, 11   'xlFilterAllDatesInPeriodQuarter2
End with

:d
http://www.snb-vba.eu/VBA_Autofilter.html
https://learn.microsoft.com/en-us/office/vba/api/excel.xldynamicfiltercriteria

 

[snb]

@AD1957

Sjonge, Ad, ik wou dat ik zo goed was in VBA
Zelf helemaal vergeten...

herziene versie:

Sub M_snb()
  Application.DisplayAlerts = False
  y = InputBox("kwartaal", "snb")
   
  With Blad1.ListObjects(1).DataBodyRange
    .AutoFilter 1, 16 + y, 11
    .Copy
    With Sheets.Add(, Sheets(Sheets.Count))
      .Paste
      .Copy
      With ActiveWorkbook
        .SaveAs ThisWorkbook.Path & "\kwartaal2.xlsx", 51
        .Close 0
      End With
      .Delete
    End With
    .AutoFilter
  End With
End Sub

 

[AD1957]

Pffffffff :d:d

Alleen heeft TS niets aan deze voorstellen/codes zie post #20

 

[snb]

Als hij/zij volhardt en adviesresistent is....

 

[RMSpan]

Ik ben door tijdgebrek nog niet aan jullie oplossingen toe gekomen. Dus wordt vervolgd
Ik ga ze zeker uitproberen