Discussion :

[lilmonie]

Bonjour!

en espérant avoir un retour! je veux copier mon tableau6, après avoir fait un tri, vers une feuille "Recap" du classeur "Delta". J'ai utilisé ce code mais j'ai l'erreur suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
'Filtre tableau et copie vers feuille "PF"
wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=38, Criteria1:="PI"
wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=31, Criteria1 _
        :="=P", Operator:=xlOr, Criteria2:="=N"
wsSource.Range("Tableau6[#data]").Columns("A:AL").Copy PF.Range("A2")
PF.Range("A2:AL1048576").WrapText = False
 
'Copie vers Delta
Dim shtExport As Worksheet
Set wkDestination = Application.Workbooks.Open("C:\User\E457657\Documents\Important\Delta.xlsm")
Set shtExport = wkDestination.Worksheets("Recap")
 
    With wsSource.Range("Tableau6[#data]").Columns("A:AL")
         shtExport.Rows(2).Resize(.Rows.Count).Insert
        .Copy shtExport.Range("A2")
    End With
 
    Set shtExport = Nothing
wkDestination.Close True 'Ferme en sauvant.
If wsSource.FilterMode Then wsSource.ShowAllData

Voici l'erreur

[had4789]

Bonjours,

Tu peux adapter ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub Importation()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
Sheets("Extraction").Columns("A:Y").ClearContents
 
Dim titre As String
Dim wbk1 As Workbook
Dim wbk2 As Workbook
titre = "\\H:\Commun\Dossiers test Section\2054\Plan.csv"
' dans le titre tu indiques ton chemin d'accès
'services\192:168.58.101\public\H:
 
Set wbk1 = ThisWorkbook
Set wbk2 = Workbooks.Open(titre, local:=True)   ' jouvre le classeur (titre)
 
wbk2.Sheets(1).Range("A:Y").Copy Destination:=wbk1.Sheets("Extraction").Range("A1")
wbk2.Close
 
End Sub

[lilmonie]

Bonjour et merci pour votre réponse
J'ai vu dans votre qu'il y a un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.clearContents

. Je ne veux pas effacer le tableau dans l'onglet de destination car mes données dans tableau6 change chaque semaine et je veux pouvoir garder une trace de tableau6 dans le classeur Delta

[had4789]

Cette ligne est optionnelle, tu peux donc la supprimer. Je m'en sers juste pour être sûre de n'avoir que les nouvelles données.

[lilmonie]

Je voulais savoir avec ce code je peux garder à chaque fois mes données précédentes? est ce que les données ne sont pas écrasés lors du collage?

j'avais déjà remodifier ma macro de départ et j'avais plus l'erreur affiché dans mon 1er post mais voici les erreurs que j'ai après le filtre dans tableau6

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Dim shtExport As Worksheet
titre = "C:\User\E457657\Documents\Important\Delta Semaine.xlsm"
'Tri sur colonnes 31 et 38
wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=31, Criteria1 _
        :="=P", Operator:=xlOr, Criteria2:="=N"
    wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=38, Criteria1 _
        :="PI"
'J'ouvre mon classeur
Set wkDestination = Workbooks.Open(titre, local:=True)
Set shtExport = wkDestination.Worksheets("Recap")
'Avec le résultat de tri, copie dans classeur Delta et onglet TP=thisworkbook.worksheets("TP")
With wsSource.Range("Tableau6[#data]").Columns("A:AL")
shtExport.Rows(2).Resize(.Rows.Count).Insert 'je veux insérer sur cellules du haut
.Copy shtExport.Range("A2")
.Copy TP.Range("A2")
End With
TP.Range("A2:AL1048576").WrapText = False
shtExport.Range("A2:AL1048576").WrapText = False
Set shtExport = Nothing
wkDestination.Close True 'Ferme en sauvant.
If wsSource.FilterMode Then wsSource.ShowAllData

Alors quand j'exécute, déjà:
1. dans ma feuille "Recap" du classeur Delta (cad shExport) de destination, je n'ai pas le résultat de filtre mais le tableau6 sans filtre
2.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

shtExport.Rows(2).Resize(.Rows.Count).Insert

j'ai des colonnes vides qui s'insèrent avant le collage du tableau
3. j'ai le résultat de filtre que dans la feuille TP du classeur source

[had4789]

Bonjour,

Pour les copie filtrée je ne suis pas un pro mais essais un paste.

Tu peux aussi faire une recherche sur le forum le sujet a déjà été abordé.

Tu peux enfin utiliser l'enregistreur de macro qui est ton meilleur amis après Google.

[lilmonie]

au final j'ai modifié un peu ma macro mais lors du collage dans le classeur de destination, j'ai des lignes vides qui sont présentes alors je voudrais savoir comment coller sans les lignes vides.
Voici le code que j'ai utilisé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=32, Criteria1 _
        :=Array("O", "P", "V"), Operator:=xlFilterValues
wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=39, Criteria1 _
        :="KI"
 With wsSource.Range("Tableau6[#data]").Columns("A:AM")
        shtExport.Rows(2).Resize(.Rows.Count).Insert
        .Copy shtExport.Range("A2")
    End With
  Set shtExport = Nothing

d'un autre côté, j'ai testé aussi le code ci-dessous. Mais lors du collage, je n'ai que des lignes à cellules vides pourtant en faisant pas à pas, mon tableau est bien copié^^

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=32, Criteria1 _
        :=Array("O", "P", "V"), Operator:=xlFilterValues
wsSource.ListObjects("Tableau6").Range.AutoFilter Field:=39, Criteria1 _
        :="KI"
wsSource.Range("Tableau6[#data]").Columns("A:AM").Copy
shtExport.Activate
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Insert shift:=xlDown
Set shtExport = Nothing
wkDestination.Close True 'Ferme en sauvant.
If wsSource.FilterMode Then wsSource.ShowAllData

[Marc-L]

Bonjour,

utiliser SpecialCells(xlCellTypeVisible) après filtrage comme dans cette discussion parmi les nombreux exemples de ce forum …


__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …