XL 2010 Copie lignes avec format VBA

herve62

XLDnaute Barbatruc
Supporter XLD
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 !!
 

Pièces jointes

  • LISTE 1.xlsx
    11.2 KB · Affichages: 12
  • Test copie.xlsm
    20.1 KB · Affichages: 8

job75

XLDnaute Barbatruc
Bonjour herve62,

La solution classique est celle-ci :
VB:
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+
 
Dernière édition:

job75

XLDnaute Barbatruc
Si l'on veut choisir le dossier où se trouvent les fichiers à traiter :
VB:
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

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Barbatruc
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 :
VB:
Set R = Sheets("ME").Rows("1:12")
Et s'il faut préciser la feuille de destination :
Code:
Sheets("MODE DEMPLOI").Cells.Delete 'RAZ
R.Copy Sheets("MODE DEMPLOI").Cells(1)
 

job75

XLDnaute Barbatruc
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 :
VB:
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

XLDnaute Barbatruc
Supporter XLD
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 !!!!
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour herve62, le forum,

Pour récupérer le chemin du dossier le plus simple est d'utiliser InitialFileName :
VB:
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+
 

Discussions similaires