Copie données triées depuis classeur fermé - PasteSpecial → 1004 aléatoire

Le 11/07/2023 à 18:23

Bonjour à tous,

je cherche à copier des données d'un classeur fermé.
C'est données sont d'abord triées pour ne sélectionner que ce qui m'intéresse.
Je fais ensuite un copier coller mais régulièrement le PasteSpecial échoue avec une erreur 1004

Le sujet est bien sûr traité de nombreuses fois sur internet mais je ne parviens toujours pas à trouver une solution fonctionnelle.

Je n'ai pas trouvé d'autres méthodes que le PasteSpecial pour copier depuis un classeur fermé.

Auriez vous une idée ?

Sub CopieDonnees()

Application.ScreenUpdating = False
'On Error Resume Next 'Ignore les erreurs, relancer la macro au besoin

Dim XLApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim NOM As String
Dim lastfilterRow As Integer

Sheets("DonnéesBrutes").Cells.Clear 'On vide le classeur pour éviter d'afficher des projets terminés

'Ouvrir le classeur dont on a besoin avec tout le chemin...

NOM = "JD"
Set xlBook = XLApp.Workbooks.Open(Environ("USERPROFILE") & "\chemin\vers\monfichier.xlsm", ReadOnly:=True)

Set xlSheet = xlBook.Sheets("TAB BORD") ' si on veut utiliser une feuille en particulier

With xlSheet
If .FilterMode Then xlSheet.ShowAllData 'Supprime l'ensemble des filtres
End With

lastfilterRow = xlSheet.Range(["B65535"]).End(xlUp).Row ' récupère la dernière ligne non vide. Colonne B car arrive que colonne soit vide
xlSheet.Range("$A$3:$AV$" & lastfilterRow).AutoFilter Field:=13, Criteria1:=NOM 'Filtre les lignes du chargé de projet
xlSheet.Range("$A$3:$AV$" & lastfilterRow).AutoFilter Field:=26, Criteria1:=Array("DEV", "PROSP", "="), Operator:=xlFilterValues 'Sélectionne uniquement les projets en cours

lastfilterRow = xlSheet.Range(["B65535"]).End(xlUp).Row 'récupère la dernière ligne non vide

Application.DisplayAlerts = False 'évite un bug du pasteSpecial

xlSheet.Range("A3:B" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 1).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("E3:E" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 3).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("Y3:Y" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 4).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AB3:AB" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 5).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AE3:AE" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 6).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AH3:AH" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 7).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AI3:AI" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 8).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AJ3:AJ" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 9).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AM3:AM" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 10).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AN3:AN" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 11).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AO3:AO" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 12).PasteSpecial Paste:=xlPasteValues

xlSheet.Range("AP3:AP" & lastfilterRow).Copy
Sheets("DonnéesBrutes").Cells(2, 13).PasteSpecial Paste:=xlPasteValues

Application.DisplayAlerts = True

Sheets("DonnéesBrutes").Range("A1").Copy 'Évite l'alerte de presse papier plein (la méthode Application.CutCopyMode = False ne fonctionnant pas)

xlBook.Close SaveChanges:=False 'Fermeture du Tableau de bord sans enregistrer
XLApp.DoEvents 'laisse le temps à excel de fermer le document/process
XLApp.quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set XLApp = Nothing

Application.ScreenUpdating = True

End Sub

Avec le On Error Resume Next, on a plus d'erreur qui s'affiche.
Si les données copiées semblent incomplète, on relance la macro à la main (c'est un bouton)

J'ai bien sûr essayé de compléter le PasteSpecial avec

, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Mais rien n'y change.

Auriez vous une idée pour m'aider ?

Merci d'avance.

Le 11/07/2023 à 19:41

Bonjour Trumter et

Avez-vous essayé de regarder du côté de PQ (Power Query)

A+

Le 11/07/2023 à 20:04

bonjour Trumter, un essai avec seulement un copie&colle, je pense qu'autrement vous devez freiner un petit peu avec "DoEvents"

Sub CopieDonnees()

     Application.ScreenUpdating = False
     'On Error Resume Next 'Ignore les erreurs, relancer la macro au besoin

     Dim XLApp As New Excel.Application
     Dim xlBook As Excel.Workbook
     Dim xlSheet As Excel.Worksheet
     Dim NOM   As String
     Dim lastfilterRow As Integer

     Sheets("DonnéesBrutes").Cells.Clear     'On vide le classeur pour éviter d'afficher des projets terminés

     'Ouvrir le classeur dont on a besoin avec tout le chemin...

     NOM = "JD"
     Set xlBook = XLApp.Workbooks.Open(Environ("USERPROFILE") & "\chemin\vers\monfichier.xlsm", ReadOnly:=True)

     Set xlSheet = xlBook.Sheets("TAB BORD")     ' si on veut utiliser une feuille en particulier

     With xlSheet
          If .FilterMode Then xlSheet.ShowAllData     'Supprime l'ensemble des filtres
     End With

     lastfilterRow = xlSheet.Range(["B65535"]).End(xlUp).Row     ' récupère la dernière ligne non vide. Colonne B car arrive que colonne soit vide
     xlSheet.Range("$A$3:$AV$" & lastfilterRow).AutoFilter Field:=13, Criteria1:=NOM     'Filtre les lignes du chargé de projet
     xlSheet.Range("$A$3:$AV$" & lastfilterRow).AutoFilter Field:=26, Criteria1:=Array("DEV", "PROSP", "="), Operator:=xlFilterValues     'Sélectionne uniquement les projets en cours

     lastfilterRow = xlSheet.Range(["B65535"]).End(xlUp).Row     'récupère la dernière ligne non vide

     Application.DisplayAlerts = False       'évite un bug du pasteSpecial

     xlSheet.Range("C1:D1,F1:X1,Z1:AA1,Ac1:AD1,AF1:AG1,AK1:AL1").EntireColumn.Delete     'supprimer colonnes non-importantes
     xlSheet.Range("A3:A" & lastfilterRow).Resize(, 12).Copy     'copier 12 colonnes importantes
     Sheets("DonnéesBrutes").Cells(2, 1).PasteSpecial Paste:=xlPasteValues     'coller comme valeur

     Application.DisplayAlerts = True

     Sheets("DonnéesBrutes").Range("A1").Copy     'Évite l'alerte de presse papier plein (la méthode Application.CutCopyMode = False ne fonctionnant pas)

     xlBook.Close SaveChanges:=False         'Fermeture du Tableau de bord sans enregistrer
     XLApp.DoEvents                          'laisse le temps à excel de fermer le document/process
     XLApp.Quit
     Set xlSheet = Nothing
     Set xlBook = Nothing
     Set XLApp = Nothing

     Application.ScreenUpdating = True

End Sub

EDIT: bonjour Bruno

Le 12/07/2023 à 11:20

Merci BsAlv et BrunoM45 pour ces réponses rapides.

@BrunoM45, e vais chercher du côté de PQ, merci.

@BsAlv

un essai avec seulement un copie&colle

Ça copie bien des données, mais la ligne de suppression ne fonctionne pas (erreur 1004), même en supprimant le ReadOnly:=True

Mais ce sont les bonnes lignes copiées.

 xlSheet.Range("C1:D1,F1:X1,Z1:AA1,Ac1:AD1,AF1:AG1,AK1:AL1").EntireColumn.Delete     'supprimer colonnes non-importantes

je pense qu'autrement vous devez freiner un petit peu avec "DoEvents"

Oui, mais c'est peu perceptible, j'avais le soucis de la non fermeture du fichier excel, l'idée était de laisser un peu le temps pour cette fermeture.

Le 12/07/2023 à 11:58

re,

le résultat, c'est quoi ? Les données sont bien copié ou il y a encore une erreur 1004 ?

autrement en ajoutant 2 DoEvents après chaque ligne ?

xlSheet.Range("A3:B" & lastfilterRow).Copy
doevents:doevents
Sheets("DonnéesBrutes").Cells(2, 1).PasteSpecial Paste:=xlPasteValues
doevents:doevents
Le 12/07/2023 à 15:03

Merci de m'avoir répondu, la bonne réponse propre et efficace était effectivement Power Query, très puissant et efficace.
J'ai ajouté un chemin relatif avec l'astuce d'une vidéo youtube : HStUR-SXPWA (pas le droit au liens)

En résumé :
Nommer une plage de cellule "EmplacementDuFichier" ou l'on écrit son chemin relatif en vba à l'ouverture avec Environ("USERPROFILE")
Dans Power Query, après avoir ajouté un fichier excel, modification avancé et mettre :

Chemin = Excel.CurrentWorkbook(){[Name="EmplacementDuFichier"]}[Content]{0}[Column1],
Source = Excel.Workbook(File.Contents(Chemin), null, true),

Mon VBA à quasiment disparu, reste 2 lignes pour des filtres automatiques quand je change le nom du chargé de projet.

Rechercher des sujets similaires à "copie donnees triees classeur ferme pastespecial 1004 aleatoire"