1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| Function ExportByAdvancedFilter(areaSource As Range, sheetTarget As Worksheet, _
Optional ListLabel As String, _
Optional Append As Boolean = True) As Range
' Author : Philippe Tulliez
' Arguments
' areaSource (range) : Source de données
' sheetTarget (Worksheet) : Feuille cible - Les données seront exportée à partir de A1
' [ListLabel] (string) : Liste des colonnes à exporter (séparées par des ;)
' si l'argument est vide, toutes les colonens seront exportées
' [Append] (Booléen) : Faux si la liste précédente doit être effacée (Vrai par défaut)
Dim areaTarget As Range
If Not Append Then sheetTarget.Cells.Clear
Set areaTarget = sheetTarget.Range("A1").CurrentRegion
Select Case True
Case (Append = True And areaTarget.Count = 1) Or Not Append
If Len(ListLabel) Then
areaTarget = ListLabel
sheetTarget.Range("A1").TextToColumns TextQualifier:=xlDoubleQuote
End If
Set areaTarget = areaTarget.CurrentRegion
Case Else
With areaTarget
.Offset(.Rows.Count).Resize(1).Value = .Resize(1).Value ' Copie de la ligne 1
Set areaTarget = .Offset(.Rows.Count).Resize(1)
End With
End Select
areaSource.AdvancedFilter Action:=xlFilterCopy, copytorange:=areaTarget
Set ExportByAdvancedFilter = areaTarget.CurrentRegion
If areaTarget.Row > 1 Then
areaTarget.EntireRow.Delete
End If
Set areaTarget = Nothing
End Function |
Partager