Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro qui copie sous 2 conditions certaines données, imprime et sauvegarde

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

sellig 29

XLDnaute Occasionnel
Bonjour à tous,
Je souhaiterais améliorer un fichier en y apportant une macro magique! N'étant pas moi même magicien, je fais appel à ceux qui voudront bien me faire partager leur talent!
J'ai indiqué dans le fichier joint les explications.
Merci par avance
 

Pièces jointes

Trier par date Trier par votes
Re : Macro qui copie sous 2 conditions certaines données, imprime et sauvegarde

Dans les explications jointes à mon post précédent, j'ai fais une erreur dans la désignation d'une colonne (J'ai dit AE, il fallait: X). J'ai rectifié dans cette nouvelle PJ. 😱
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Macro qui copie sous 2 conditions certaines données, imprime et sauvegarde

Bonjour Sellig,

Une tentative sans prétention. Le dossier de sauvegarde est indiqué dans la constante archiREP et se termine par un antislash.
Edit : version v2
Code: 
Sub ArchiTest()
Const archiREP = "c:\Archi_OT_(Test)\"
Dim i, iMax, NewWbk, WbkSuiviOT

Application.ScreenUpdating = False
WbkSuiviOT = ThisWorkbook.Name

'Création d 'un classeur
Workbooks.Add
NewWbk = ActiveWorkbook.Name

With Workbooks(WbkSuiviOT).Sheets("Suivi OT")
iMax = .Range("F" & .Rows.Count).End(xlUp).Row
For i = 5 To iMax
    If UCase(.Range("F" & i)) = "OUI" And .Range("X" & i) = "" Then
        'copie des valeurs vers la feuille 'Masque'
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("F15") = .Range("D" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("H18") = .Range("E" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("R5") = .Range("B" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("i11") = .Range("H" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("D31") = .Range("I" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("D34") = .Range("J" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("D36") = .Range("K" & i)
       
        'Copie de la feuille 'Masque'
        Workbooks(WbkSuiviOT).Sheets("Masque").Cells.Copy Destination:=Workbooks(NewWbk).Sheets(1).Cells
       
        'Sauvegarde du fichier
        ActiveWorkbook.SaveAs Filename:=archiREP & "Fiche_" & Trim(.Range("B" & i)) & ".xls", FileFormat:=xlNormal
        NewWbk = "Fiche_" & Trim(.Range("B" & i)) & ".xls"
        .Range("X" & i) = "X"
    End If
Next i
End With
Workbooks(NewWbk).Close
Application.ScreenUpdating = True
MsgBox "Terminé"
End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Macro qui copie sous 2 conditions certaines données, imprime et sauvegarde

Bonjour Sellig,

Version 3 qui embarque l'impression que j'avais omis.

Code: 
Sub ArchiTest()
Const archiREP = "c:\Archi_OT_(Test)\"
Dim i, iMax, NewWbk, WbkSuiviOT

Application.ScreenUpdating = False
WbkSuiviOT = ThisWorkbook.Name

'Création d 'un classeur
Workbooks.Add
NewWbk = ActiveWorkbook.Name

With Workbooks(WbkSuiviOT).Sheets("Suivi OT")
iMax = .Range("F" & .Rows.Count).End(xlUp).Row
For i = 5 To iMax
    If UCase(.Range("F" & i)) = "OUI" And .Range("X" & i) = "" Then
        'copie des valeurs vers la feuille 'Masque'
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("F15") = .Range("D" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("H18") = .Range("E" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("R5") = .Range("B" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("i11") = .Range("H" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("D31") = .Range("I" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("D34") = .Range("J" & i)
        Workbooks(WbkSuiviOT).Sheets("Masque").Range("D36") = .Range("K" & i)
       
        'Copie de la feuille 'Masque'
        Workbooks(WbkSuiviOT).Sheets("Masque").Cells.Copy Destination:=Workbooks(NewWbk).Sheets(1).Cells
        
        'Impression de la feuille
        With Workbooks(NewWbk).Sheets(1).PageSetup
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
        Workbooks(NewWbk).Sheets(1).Range("B2:U81").PrintOut Copies:=1   ', IgnorePrintAreas:=False
       
        'Sauvegarde du fichier
        'test si fichier existe
        If Dir(archiREP & "Fiche_" & Trim(.Range("B" & i)) & ".xls") <> "" Then
            If MsgBox(prompt:="Le fichier : " & archiREP & "Fiche_" & Trim(.Range("B" & i)) & ".xls" & _
            vbCrLf & "existe déjà ! Voulez-vous l'écraser ?", Buttons:=vbYesNo) = vbYes Then
                Application.DisplayAlerts = False
                Workbooks(NewWbk).SaveAs Filename:=archiREP & "Fiche_" & Trim(.Range("B" & i)) & ".xls", _
                    FileFormat:=xlNormal
                 Application.DisplayAlerts = True
                NewWbk = "Fiche_" & Trim(.Range("B" & i)) & ".xls"
                .Range("X" & i) = "X"
            End If
        Else
            Workbooks(NewWbk).SaveAs Filename:=archiREP & "Fiche_" & Trim(.Range("B" & i)) & ".xls", _
                FileFormat:=xlNormal
            NewWbk = "Fiche_" & Trim(.Range("B" & i)) & ".xls"
            .Range("X" & i) = "X"
        End If
    End If
Next i
End With
Workbooks(NewWbk).Saved = True
Workbooks(NewWbk).Close
Application.ScreenUpdating = True
MsgBox "Terminé"
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Macro qui copie sous 2 conditions certaines données, imprime et sauvegarde

Merci Mapomme mais l'impression se fait uniquement pour la 1ère ligne (18), la sauvegarde ne se réalise pas dans le fichier et j'ai un bug qui apparait lorsque j'exécute la macro
 
Vote positif 0 Vote négatif
Re : Macro qui copie sous 2 conditions certaines données, imprime et sauvegarde

Bonjour Sellig,

Un autre essai:
1) les données sont sauvegardées sur la feuille 'Archives valeurs'
2) L'impression est remplacée par un aperçu (pour les tests)
pour rétablir l'impression, désactiver les deux lignes : Sheets("Masque").Range("B2:U81").PrintPreview
et activer les deux lignes : Sheets("Masque").Range("B2:U81").PrintOut Copies:=1
3) pour ré-imprimer une ligne archivée, double-cliquer sur la ligne dans la feuille 'Archives valeurs'

Les codes se trouvent dans le module 'Module1' et dans le module de la feuille 'Archives valeurs'

nota : utilisant Excel 2010, je ne suis pas certain de la manière de fonctionner de l'aperçu!
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Macro qui copie sous 2 conditions certaines données, imprime et sauvegarde

C'est impeccable mapomme! Pour une tentative sans prétention (ton post N°1), quelle modestie... Avec tous mes remerciments.
Bonne journée
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Question Question
XL 2010 VBA - macro avec 1 boucle qui alterne 1 action à conditions et 1 action sans conditions
2 3 4
Réponses
58
Affichages
9 K
Scorp0211
S
B
  • Question Question
XL 2013 [VBA] Extraction de données basé sur 2 à 3 conditions
Réponses
2
Affichages
2 K
bastienb
B
Y
  • Question Question
XL 2016 Help : Macro filtrage multicritères sur des lignes
Réponses
11
Affichages
3 K
ynx69
Y
J
  • Question Question
XL 2013 Copie de 2 onglets en 6 exemplaires et les renommer
Réponses
4
Affichages
1 K
jmten92
J
E
  • Question Question
Envoi mail automatique avec PJ et condition
Réponses
1
Affichages
901
Paritec
L
  • Question Question
VBA : Macro pour copier et supprimer des données
Réponses
10
Affichages
23 K
Yaloo
Y
M
  • Question Question
pour les pros lol copie cel ds feuille suivant conditions..
3 4 5
Réponses
64
Affichages
7 K
mos98
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…