XL 2010 Extraction après application de filtre

[Raziel abel]

Bonjour le forum, les XLdNautes,

J'ai besoin de vos lumières concernant un code VBA qui permettrait après application des filtres de pouvoir après avoir appuyer sur un bouton d'extraire les données voulues dans un autre onglet ou mieux dans un autre classeur (qu'on pourrait nommer Extract_Data).

Pensez vous que cela soit possible?

Cordialement,

Raziel_Abel

 

[job75]

Bonsoir Raziel abel,

Les 2 solutions :

Sub CopieFiltre1()
With Sheets("Exctration_Data") 'sic...
    .Cells.Delete 'RAZ
    Sheets("Data").[A5].CurrentRegion.Copy .[A1]
    .Columns.AutoFit
End With
End Sub

Sub CopieFiltre2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
With Workbooks.Add
    ThisWorkbook.Sheets("Data").[A5].CurrentRegion.Copy .Sheets(1).[A1]
    .Sheets(1).Columns.AutoFit
    .SaveAs ThisWorkbook.Path & "\Extract_Data.xlsx" 'chemin d'accès à adapter éventuellement
    .Close True
End With
End Sub

Bonne fin de soirée.

 

[Raziel abel]

Bonsoir Raziel abel,

Les 2 solutions :

Sub CopieFiltre1()
With Sheets("Exctration_Data") 'sic...
    .Cells.Delete 'RAZ
    Sheets("Data").[A5].CurrentRegion.Copy .[A1]
    .Columns.AutoFit
End With
End Sub

Sub CopieFiltre2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
With Workbooks.Add
    ThisWorkbook.Sheets("Data").[A5].CurrentRegion.Copy .Sheets(1).[A1]
    .Sheets(1).Columns.AutoFit
    .SaveAs ThisWorkbook.Path & "\Extract_Data.xlsx" 'chemin d'accès à adapter éventuellement
    .Close True
End With
End Sub

Bonne fin de soirée.

Bonjour et encore merci,

je viens de tester le premier code qui fonctionne parfaitement.
Pour le deuxième code, je met le chemin d'accés en entier?

genre:
.SaveAs ThisWorkbook.Path & "\Extract_Data.xlsx" 'C:\Users\yx548748\Documents\WorkShop_Saïgon\BASE GENERAL A TRAVAILLER


Encore merci pour votre aide.

Bien cordialement,

Raziel

 

[Raziel abel]

Bonjour à toutes et à tous,

Je reviens avec un fichier un peu plus capilo_tracté au niveau de ma demande.
Pouvons nous exporter seulement les colonnes A, B, C, D, E, F,I, N, R, W, X, Y, Z, AB, après application du filtre dans un autre onglet (Extraction_Data)?

Dernière question:
Est-il possible d'exporter sur d'autres onglets, sans écraser le premier export, lorsque nous souhaitons faire d'autres extractions de filtres?

En vous remerciant,

XlD_Notrement

 

[Raziel abel]

Bonjour,

Je suis désolè de faire remonter le Topic.
Merci beaucoup d'avance pour votre aide.

Bien cordialement,

RZ

 

[job75]

Bonjour Raziel abel, le forum,

Pour la 1ère question il suffit dans les 2 macros de supprimer les colonnes que vous ne voulez pas garder dans la feuille des résultats.

Pour la 2ème question il suffit à chaque fois de créer une feuille ou un fichier avec un nom différent.

Nombreux exemples sur le forum, il vous faut travailler un peu !

Bonne journée.

 

[Raziel abel]

Bonjour,

Merci pour votre retour.
J'aime bien "fouiner" dans ce forum qui m'en apprends tous les jours sur Excel (et pas que...).

J'ai utiliser le premier code dans une autre feuille et là cela ne fonctionne pas aussi bien.
C'est à dire que j'ai bien une extraction mais cette fois-ci de toutes les données.

Cells.Delete 'RAZ
Sheets("Data").[A5].CurrentRegion.Copy .[A1] => Est-ce là que je dois instruire au code les colonnes que je souhaite garder ou supprimer?

Merci encore pour votre retour .

Cordialement,

 

[job75]

Re,

En ne voulant pas se fatiguer on ne progresse pas sur Excel !

Sub CopieFiltre1()
Application.ScreenUpdating = False
Dim P As Range, col%
With Sheets.Add(After:=Sheets(Sheets.Count))
    .Name = "Extract_" & Format(Now, "yyyymmdd_hhmmss")
    Sheets("Data").[A5].CurrentRegion.Copy .[A1]
    Set P = .[A:F,I:I,N:N,R:R,W:Z,AB:AB] 'colonnes à conserver
    For col = .[A1].CurrentRegion.Columns.Count To 1 Step -1
        If Intersect(.Columns(col), P) Is Nothing Then .Columns(col).Delete
    Next
    .Columns.AutoFit
End With
End Sub

Sub CopieFiltre2()
Dim P As Range, col%
Application.ScreenUpdating = False
With Workbooks.Add.Sheets(1)
    ThisWorkbook.Sheets("Data").[A5].CurrentRegion.Copy .[A1]
    Set P = .[A:F,I:I,N:N,R:R,W:Z,AB:AB] 'colonnes à conserver
    For col = .[A1].CurrentRegion.Columns.Count To 1 Step -1
        If Intersect(.Columns(col), P) Is Nothing Then .Columns(col).Delete
    Next
    .Columns.AutoFit
    .Parent.SaveAs ThisWorkbook.Path & "\Extract_" & Format(Now, "yyyymmdd_hhmmss") & ".xlsx" 'chemin d'accès à adapter éventuellement
    .Parent.Close True
End With
End Sub

Les noms donnés permettent de classer en ordre chronologique les feuilles ou les fichiers.

A+

 

[job75]

Re,

Mais au lieu de supprimer des colonnes on peut ne copier que les colonnes listées, c'est plus rapide :

Sub CopieFiltre11()
Application.ScreenUpdating = False
With Sheets.Add(After:=Sheets(Sheets.Count))
    .Name = "Extract_" & Format(Now, "yyyymmdd_hhmmss")
    Intersect(Sheets("Data").[A5].CurrentRegion, Sheets("Data").[A:F,I:I,N:N,R:R,W:Z,AB:AB]).Copy .[A1]
    .Columns.AutoFit
End With
End Sub

Sub CopieFiltre12()
Application.ScreenUpdating = False
With Workbooks.Add
    Intersect(ThisWorkbook.Sheets("Data").[A5].CurrentRegion, ThisWorkbook.Sheets("Data").[A:F,I:I,N:N,R:R,W:Z,AB:AB]).Copy .Sheets(1).[A1]
    .Sheets(1).Columns.AutoFit
    .SaveAs ThisWorkbook.Path & "\Extract_" & Format(Now, "yyyymmdd_hhmmss") & ".xlsx" 'chemin d'accès à adapter éventuellement
    .Close True
End With
End Sub