XL 2010 Copie lignes avec format VBA

[herve62]

Bonjour
J'ai a modifier un grand nombre de fiches (comme Liste 1.xlsx) en prenant le texte de Copie test.xlsm pour remplacer
dans la feuille Mode DEMPLOI
J'ai toujours évité les Copy/paste , mais là il faut garder le format du modèle donc j'essaye avec ROWS
; j'ai pris le code enregistré macro et adapté Mais cela ne fonctionne pas !!

 

[job75]

Bonjour herve62,

La solution classique est celle-ci :

Sub mod_emploi()
Dim t#, chemin$, fichier$, R As Range, n%
t = Timer
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "*.xlsx")
Set R = Sheets("ME").UsedRange.EntireRow 'plage source à adapter
Application.ScreenUpdating = False
While fichier <> ""
    n = n + 1
    Workbooks.Open chemin & fichier
    Cells.Delete 'RAZ
    R.Copy Cells(1) 'copier-coller
    ActiveWorkbook.Close True 'enregistre et ferme le fichier
    fichier = Dir
Wend
MsgBox n & " fichier(s) .xlsx traité(s) en " & Format(Timer - t, "0.00 \sec")
End Sub

Avec ce code le fichier de la macro doit être dans le même dossier que les fichiers à traiter.

Edit : j'avais oublié Cells.Delete

A+

 

[job75]

Si l'on veut choisir le dossier où se trouvent les fichiers à traiter :

Sub mod_emploi()
Dim dossier As FileDialog, t#, chemin$, fichier$, R As Range, n%
Set dossier = Application.FileDialog(msoFileDialogFolderPicker)
If dossier.Show = False Then Exit Sub 'Annuler
t = Timer
Set R = Sheets("ME").UsedRange.EntireRow
chemin = dossier.SelectedItems(1) & "\"
fichier = Dir(chemin & "*.xlsx")
Application.ScreenUpdating = False
While fichier <> ""
    n = n + 1
    Workbooks.Open chemin & fichier
    Cells.Delete 'RAZ
    R.Copy Cells(1)
    ActiveWorkbook.Close True 'enregistre et ferme le fichier
    fichier = Dir
Wend
MsgBox n & " fichier(s) .xlsx traité(s) en " & Format(Timer - t, "0.00 \sec")
End Sub

 

[herve62]

Bonsoir JOB
Merci du retour
Mais je pige pas tout !!! surtout ou se trouve ma plage ( les 12 lignes) à copier ?
et aussi le format ? ( hauteur de ligne , car dans les anciens fichiers celle ci n'est plus bonne )

Set R = Sheets("ME").UsedRange.EntireRow

??

R.Copy Cells(1)

??
Enfin je ne vois pas la selection de la feuille MODE DEMPLOI dans la destination , là j'ai supprimé dans l'exemple les autres feuilles sinon j'en ai 4

 

[job75]

Si tu ne comprends pas teste les macros sur les fichiers de ton post #1.

Maintenant tu n'es quand même pas débutant, alors s'il y a toujours 12 lignes à copier :

Set R = Sheets("ME").Rows("1:12")

Et s'il faut préciser la feuille de destination :

Sheets("MODE DEMPLOI").Cells.Delete 'RAZ
R.Copy Sheets("MODE DEMPLOI").Cells(1)

 

[herve62]

Ok je testerai demain , mais comme déjà dit j'aime bien comprendre ce que je fais
Comme on disait à l'école : ne pas recopier bêtement !!!!
Là déjà cela va mieux avec le nouveau R , le 1er (usedRange) euh ??

 

[herve62]

Bonjour
@job : Je suis en train de tester , mais un petit hic > J'ouvre l'explo mais comment contrôler que ce sont les bons fichiers XLSX dedans ?
j'ai essayé mais je trouve pas ?

 

[job75]

Bonjour herve62,

Si l'on veut voir les fichiers .xlsx du dossier choisi il faut utiliser la boîte de dialogue qui ouvre les fichiers :

Sub mod_emploi()
Dim fd As FileDialog, t#, chemin$, fichier$, R As Range, n%
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "CLIQUER SUR UN FICHIER QUELCONQUE DU DOSSIER CHOISI"
fd.Filters.Add "Classeurs Excel", "*.xlsx"
If fd.Show = False Then Exit Sub 'Annuler
t = Timer
chemin = Left(fd.SelectedItems(1), InStrRev(fd.SelectedItems(1), "\"))
fichier = Dir(chemin & "*.xlsx")
Set R = Sheets("ME").Rows("1:12")
Application.ScreenUpdating = False
While fichier <> ""
    n = n + 1
    Workbooks.Open chemin & fichier
    Sheets("MODE DEMPLOI").Cells.Delete 'RAZ
    R.Copy Sheets("MODE DEMPLOI").Cells(1)
    ActiveWorkbook.Close True 'enregistre et ferme le fichier
    fichier = Dir
Wend
MsgBox n & " fichier(s) .xlsx traité(s) en " & Format(Timer - t, "0.00 \sec")
End Sub

Le choix d'un des fichiers entraîne le traitement de tous les fichiers du dossier.

A+

 

[herve62]

Moi j'étais parti sur :
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Select"
.Filters.Add "Classeurs Excel", "*.xlsx"
...etc !!!
Mais le filters bloque ?? ( pourtant cela vient d'un vieux truc de PatrickToulon !!)

-------------------
Je modifie , je viens de piger certains points
Forcément que ça bug !!! il faut DialogOpen et pas FolderPicker
Il faut que je fasse l'amalgame au plus simple pour l'utilisateur ; Mais le choix d'affichage du rep & de ses fichiers n'est pas terrible car il faut selectionner un fichier !!! et on ne peut le préciser !!!!

 

[job75]

Forcément que ça bug !!! il faut DialogOpen et pas FolderPicker

Tu n'as pas testé la code de mon post #8...

Chez moi avec msoFileDialogOpen le filtre ne filtre rien.

 

[herve62]

Je regarde demain !! maintenant c'est foot
Faut trouver une méthode simple ... un bénévole d'asso ...est un bénévole pas un employé érudit

 

[job75]

Ce que je propose est simple, mais c'est vrai qu'il y a un amalgame dossier/fichier.

 

[herve62]

Oui c'est exactement ça JOB !!

Ce que je propose est simple

Mais ça dépend pour qui !!! > la simplicité n'est qu'un puit de connaissances bien rempli
Sur ce ! Bonne nuit

 

[job75]

Bonjour herve62, le forum,

Pour récupérer le chemin du dossier le plus simple est d'utiliser InitialFileName :

Sub mod_emploi()
Dim fd As FileDialog, t#, chemin$, fichier$, R As Range, n%
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.Title = "CLIQUER SUR UN FICHIER QUELCONQUE DU DOSSIER CHOISI"
fd.Filters.Add "Classeurs Excel", "*.xlsx"
If fd.Show = False Then Exit Sub 'Annuler
t = Timer
chemin = fd.InitialFileName 'chemin du dossier
fichier = Dir(chemin & "*.xlsx")
Set R = Sheets("ME").Rows("1:12")
Application.ScreenUpdating = False
While fichier <> ""
    n = n + 1
    Workbooks.Open chemin & fichier
    Sheets("MODE DEMPLOI").Cells.Delete 'RAZ
    R.Copy Sheets("MODE DEMPLOI").Cells(1)
    ActiveWorkbook.Close True 'enregistre et ferme le fichier
    fichier = Dir
Wend
MsgBox n & " fichier(s) .xlsx traité(s) en " & Format(Timer - t, "0.00 \sec")
End Sub

A+

 

[herve62]

Bonjour
@job75 : merci je vais terminer avec ça !