Sub ExportFilteredData()
' I. DICOM. Variables
Dim shGen As Worksheet
Dim shDicom As Worksheet
Dim DirDICOM As String
Set shGen = Sheets("Tab_Général")
Set shDicom = Sheets("Auto_DICOM")
DirDICOM = "DICOM"
' I. DICOM. Dynamic range
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set StartCell = Range("A16")
' I. DICOM. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' I. DICOM. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDICOM
' I. DICOM. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDicom.Range("A16").PasteSpecial Paste:=xlPasteAll
' I. DICOM. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' I. DICOM. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
'
' II. DAP. Variables
Dim shDAP As Worksheet
Dim DirDAP As String
Set shDAP = Sheets("Auto_DAP")
DirDAP = "DAP"
' II. DAP. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' II. DAP. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDAP
' II. DAP. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDAP.Range("A16").PasteSpecial Paste:=xlPasteAll
' II. DAP. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' II. DAP. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
'
' III. DSJ. Variables
Dim shDSJ As Worksheet
Dim DirDSJ As String
Set shDSJ = Sheets("Auto_DSJ")
DirDSJ = "DSJ"
' III. DSJ. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' III. DSJ. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDSJ
' III. DAP. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDSJ.Range("A16").PasteSpecial Paste:=xlPasteAll
' III. DSJ. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' III. DSJ. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
'
' IV. DPJJ. Variables
Dim shDPJJ As Worksheet
Dim DirDPJJ As String
Set shDPJJ = Sheets("Auto_DPJJ")
DirDPJJ = "DPJJ"
' IV. DPJJ. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' IV. DPJJ. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirDPJJ
' IV. DPJJ. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shDPJJ.Range("A16").PasteSpecial Paste:=xlPasteAll
' IV. DPJJ. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' IV. DPJJ. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
'
' V. PVAM. Variables
Dim shPVAM As Worksheet
Dim DirPVAM As String
Set shPVAM = Sheets("Auto_PVAM")
DirPVAM = "PVAM"
' V. PVAM. Find last row
Worksheets("Tab_Général").UsedRange
LastRow = shGen.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' V. PVAM. Filter
shGen.Range("A16:P" & LastRow).AutoFilter
shGen.Range("A16:P" & LastRow).AutoFilter Field:=3, Criteria1:=DirPVAM
' V. PVAM. Copy/paste
shGen.Range("A16:P" & LastRow).Select
shGen.Range("A16:P" & LastRow).Copy
shPVAM.Range("A16").PasteSpecial Paste:=xlPasteAll
' V. PVAM. Reinitialise
Application.CutCopyMode = False
shGen.AutoFilterMode = False
shGen.ShowAllData
' V. PVAM. Reinitialise the shGen filters (chrono order)
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort. _
SortFields.Add Key:=Range("Tableau12[[#All],[Date création]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tab_Général").ListObjects("Tableau12").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub