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

Microsoft 365 Remplissage automatique d'une feuille à l'autre

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Todre
  • Date de début Date de début

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

Todre

XLDnaute Occasionnel
Bonjour à tous,

Je possède un fichier Excel pour le suivi de mes véhicules. J'ai une feuille qui me sert d'ordre d'exécution que je dois donner à mon conducteur pour pouvoir aller au garage avec qui servira plus tard pour la facturation avec mes gestionnaires de flotte.
En parallèle, j'ai créer une feuille pour avoir un suivi perso de mes véhicules à l'année.
J'aimerai, lorsque je rempli ma feuille perso, que certaines infos (2 voir 3) viennent remplir la feuille 1 (l'ordre d'exécution). Lorsque je remplis une nouvelle ligne cela remplis de nouveau la feuille avec les nouvelles informations ainsi de suite comme ca je suis capable de sortir à tt moment un historique Excel de mes véhicules.
En prime, si je peux avoir un bouton "envoyer par mail en pdf" et "imprimer" ce serait top de chez top.
Pour info la feuille ordre d'exécution (feuille 1) va déjà chercher des infos dans des feuilles masquées suivant ma saisie.

Pouvez vous me dire si cela est possible ? Je ne peux pas mettre en partage le fichier, il contient beaucoup d'informations RGPD.

D'avance merci à vous pour votre aide 😉
 
Solution
Je te propose ce code qui remplace en totalité l'ancien code
La partie verte se met à jour dès que tu cliques sur le bouton bleu "MAJ info" et que tu sois n’importe où !

VB: 
Sub Info()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig&, Col&, i&, Derlig&

Lig = ActiveCell.Row
Col = ActiveCell.Column

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
Set Ws2 = Worksheets("Suivi véhicules") 'Source

Derlig = Ws2.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To Derlig
    If Ws2.Range("I" & i) <> "" Then
        ' Tu choisis parmi les 4 couleurs vertes celle que tu veux
        Ws2.Range("A" & i & ":L" & i).Interior.ColorIndex = 4 '<== 4 ou 10 ou 43 ou 50
    Else
        Ws2.Range("A" & i & ":L" &...
Trier par date Trier par votes
Je te propose

Dans le code "Sub info" tu rajoutes ces lignes



VB: 
        Select Case .Range("H" & Lig) '.Value
        Case "GROUPE DEKRA VL (NORISKO, AUTOCONTROL)"
            Ws1.Range("B11") = "Controle_technique"
        Case "80136 RIVERY - GARAGE GUEUDET SARVA"
            Ws1.Range("B11") = "MECANIQUE_LOURDE"
        Case Else
            Ws1.Range("B11") = ""
        End Select

Tu fais les tests etc...... fonctionne sur toutes les lignes ...
 

Pièces jointes

  • 1704809300103.png
    71.9 KB · Affichages: 19
Vote positif 0 Vote négatif
Et pour ta dernière demande

Je te propose

Dans le code "Sub info" tu rajoutes ces lignes



VB: 
        '**********Ligne à rajouter'
        Dim i&, Derlig&
        Derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 6 To Derlig
            If .Range("I" & i) <> "" Then
                ' Tu choisis parmi les 4 couleurs vertes celle que tu veux
                .Range("A" & i & ":L" & i).Interior.ColorIndex = 4 '<== 4 ou 10 ou 43 ou 50
            Else
                .Range("A" & i & ":L" & i).Interior.ColorIndex = xlColorIndexNone
            End If
        Next i
        '********** Fin de ligne Ligne à rajouter'
 
Vote positif 0 Vote négatif
J'ai quasi tout ok, il me manque juste pour le garage Renault.

Le code actuel:

 
Vote positif 0 Vote négatif
Oulala sans l'indentation c'est super difficile à déchiffrer !!

Tu devrais avoir ceci qui fonctionne chez moi

VB: 
Sub Info()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig&, Col&

Lig = ActiveCell.Row
Col = ActiveCell.Column

If Col = 2 And Lig > 5 And ActiveCell.Value <> "" Then
    Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
    Set Ws2 = Worksheets("Suivi véhicules") 'Source
    With Ws2
        Dim i&, Derlig&
        Derlig = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 6 To Derlig
            If .Range("I" & i) <> "" Then
                ' Tu choisis parmi les 4 couleurs vertes celle que tu veux
                .Range("A" & i & ":L" & i).Interior.ColorIndex = 4 '<== 4 ou 10 ou 43 ou 50
            Else
                .Range("A" & i & ":L" & i).Interior.ColorIndex = xlColorIndexNone
            End If
        Next i
 
        Ws1.Range("B7") = .Range("B" & Lig)
        Ws1.Range("B20") = .Range("E" & Lig)
        Ws1.Range("B30") = .Range("F" & Lig)
        Ws1.Range("D11") = .Range("H" & Lig)
        Select Case .Range("H" & Lig) '.Value
        Case "GROUPE DEKRA VL (NORISKO, AUTOCONTROL)"
            Ws1.Range("B11") = "Controle_technique"
        Case "80330 LONGUEAU - GARAGE LAPORTE"
            Ws1.Range("B11") = "MECANIQUE_LOURDE"
        Case Else
            Ws1.Range("B11") = ""
        End Select
    End With
Else
    MsgBox "Pas de véhicule choisi !", vbExclamation, "Essaye encore !"
End If

Set Ws1 = Nothing: Set Ws2 = Nothing
End Sub

Sub RAZ() 'Pas sur qu cela soit utile maintenant
Application.ScreenUpdating = False
Dim Ws1 As Worksheet

Set Ws1 = Worksheets("BON DE COMMANDE") 'Source
With Ws1
    .Range("B7") = ""    'Immat
    .Range("B20") = ""   'Motif
    .Range("B30") = ""   'Date depose
End With
Set Ws1 = Nothing
End Sub

Sub Impression()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Derlig%

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
With Ws1.PageSetup
    Derlig = Range("A" & Rows.Count).End(xlUp).Row
    .PrintArea = "$A$2:$E$53"           'Zone d'impression
    .FitToPagesWide = 1                 'Contrôle la largeur de la page
End With
Sheets(Ws1.Name).PrintOut               'Imprime la feuille
Set Ws1 = Nothing
End Sub

Sub ExportPDF()
Dim Chemin$, NFichier$, Ws1 As Worksheet, MaDate$

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination

'La ou se trouve ton fichier excel
Chemin = Worksheets("Suivi véhicules").Range("E4") & "\"                    'Chemin en dur dans la feuille

If Worksheets("Suivi véhicules").Range("E4") = "" Then MsgBox "Il manque le chemin cellule E4 !!!", vbCritical, "Pas de bol !": Exit Sub

If Ws1.Range("B7").Value = "" Or Ws1.Range("B30") = "" Then
    MsgBox "C'est quoi ce binzzzz !... Il n'y a pas d'immatriculation et/ou de date valide", vbCritical, "Tu fais n'importe quoi !"
    Exit Sub
End If

MaDate = Ws1.Range("B30") '==> Date de depose
MaDate = Format(MaDate, "yyyy-mm-dd")

NFichier = Ws1.Range("B7").Value & "-" & MaDate & ".pdf"

If Dir(Chemin & NFichier) <> "" Then
    'le fichier existe déjà et suivant réponse de l'utilisateur
    If MsgBox("Le fichier existe déjà, voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Confirmation") = vbYes Then
        'Création du fichier PDF
        Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
    Else
        MsgBox "Le PDF n'a pas été crée", vbCritical, "Le fichier existe déjà"
        Exit Sub
    End If
Else    'créer le pdf
    Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
    MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
End If
End Sub

C'est plus lisible comme ceci 😉

Le code ce met à jour à chaque Mise à jour info ! (c'est modifiable bien sur )
 
Dernière édition:
Vote positif 0 Vote négatif
Je te propose ce code qui remplace en totalité l'ancien code
La partie verte se met à jour dès que tu cliques sur le bouton bleu "MAJ info" et que tu sois n’importe où !

VB: 
Sub Info()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim Lig&, Col&, i&, Derlig&

Lig = ActiveCell.Row
Col = ActiveCell.Column

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
Set Ws2 = Worksheets("Suivi véhicules") 'Source

Derlig = Ws2.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To Derlig
    If Ws2.Range("I" & i) <> "" Then
        ' Tu choisis parmi les 4 couleurs vertes celle que tu veux
        Ws2.Range("A" & i & ":L" & i).Interior.ColorIndex = 4 '<== 4 ou 10 ou 43 ou 50
    Else
        Ws2.Range("A" & i & ":L" & i).Interior.ColorIndex = xlColorIndexNone
    End If
Next i
        
If Col = 2 And Lig > 5 And ActiveCell.Value <> "" Then
    With Ws2
        Ws1.Range("B7") = .Range("B" & Lig)
        Ws1.Range("B20") = .Range("E" & Lig)
        Ws1.Range("B30") = .Range("F" & Lig)
        Ws1.Range("D11") = .Range("H" & Lig)
        
        Select Case .Range("H" & Lig)
        Case "GROUPE DEKRA VL (NORISKO, AUTOCONTROL)"
            Ws1.Range("B11") = "Controle_technique"
        Case "80330 LONGUEAU - GARAGE LAPORTE"
            Ws1.Range("B11") = "MECANIQUE_LOURDE"
        Case Else
            Ws1.Range("B11") = ""
        End Select
    End With
Else
    MsgBox "Pas de véhicule choisi !", vbExclamation, "Essaye encore !"
End If

Set Ws1 = Nothing: Set Ws2 = Nothing
End Sub

Sub RAZ() 'Pas sur qu cela soit utile maintenant
Application.ScreenUpdating = False
Dim Ws1 As Worksheet

Set Ws1 = Worksheets("BON DE COMMANDE") 'Source
With Ws1
    .Range("B7") = ""    'Immat
    .Range("B20") = ""   'Motif
    .Range("B30") = ""   'Date depose
End With
Set Ws1 = Nothing
End Sub

Sub Impression()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Derlig%

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination
With Ws1.PageSetup
    Derlig = Range("A" & Rows.Count).End(xlUp).Row
    .PrintArea = "$A$2:$E$53"           'Zone d'impression
    .FitToPagesWide = 1                 'Contrôle la largeur de la page
End With
Sheets(Ws1.Name).PrintOut               'Imprime la feuille
Set Ws1 = Nothing
End Sub

Sub ExportPDF()
Dim Chemin$, NFichier$, Ws1 As Worksheet, MaDate$

Set Ws1 = Worksheets("BON DE COMMANDE") 'Destination

Chemin = Worksheets("Suivi véhicules").Range("E4") & "\"                    'Chemin en dur dans la feuille

If Worksheets("Suivi véhicules").Range("E4") = "" Then MsgBox "Il manque le chemin cellule E4 !!!", vbCritical, "Pas de bol !": Exit Sub

If Ws1.Range("B7").Value = "" Or Ws1.Range("B30") = "" Then
    MsgBox "C'est quoi ce binzzzz !... Il n'y a pas d'immatriculation et/ou de date valide", vbCritical, "Tu fais n'importe quoi !"
    Exit Sub
End If

MaDate = Ws1.Range("B30") '==> Date de depose
MaDate = Format(MaDate, "yyyy-mm-dd")

NFichier = Ws1.Range("B7").Value & "-" & MaDate & ".pdf"

If Dir(Chemin & NFichier) <> "" Then
    'le fichier existe déjà et suivant réponse de l'utilisateur
    If MsgBox("Le fichier existe déjà, voulez-vous le remplacer ?", vbYesNo + vbExclamation, "Confirmation") = vbYes Then
        'Création du fichier PDF
        Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
        MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
    Else
        MsgBox "Le PDF n'a pas été crée", vbCritical, "Le fichier existe déjà"
        Exit Sub
    End If
Else    'créer le pdf
    Ws1.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
    MsgBox "Le fichier a été enregitré." & vbCrLf & vbCrLf & "Ici ==> " & Chemin & vbCrLf & vbCrLf & _
        "Sous le nom : " & NFichier, 48, "Enregistrement fichier en PDF ..."
End If
End Sub
 
Vote positif 0 Vote négatif
Solution
Pour le moment c'est ok, fin du game pour aujourd'hui sinon le PC va voler je crois et j'imagine que pour toi ca doit être pire ! pour le moment j'ai le fichier que je voulais on recroise le tout demain et j'espère on clôture le truc pour de bon 😉

Merci encore une fois pour ta patience du jour !

Bonne soirée Phil 🙂
 
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
Autres Gestion flotte auto LLD - Suivi durée contrat + kilométrage
Réponses
2
Affichages
252
wDog66
N
  • Question Question
Microsoft 365 Remplissage automatique d'une feuille à l'autre
Réponses
2
Affichages
356
Nonoo
N
C
  • Question Question
XL 2016 Suivi des entretiens véhicules
Réponses
2
Affichages
470
clethu
C
N
  • Question Question
Microsoft 365 Choix d'ouverture d'une feuille
Réponses
6
Affichages
188
mapomme
I
  • Question Question
Microsoft 365 Atteindre la première case vide après collage
Réponses
5
Affichages
177
job75
N
  • Résolu(e)
Microsoft 365 Macro enregistrement automatique pdf
2
Réponses
18
Affichages
673
Nounours4173
N
  • Question Question
XL 2016 colonnes automatique
Réponses
0
Affichages
334
richardlion
L
  • Question Question
XL 2021 Transformer des données verticales en horizontales et mettre à jour un graphique automatiquement
Réponses
11
Affichages
366
Leina
L
D
  • Résolu(e)
XL 2021 Créer feuilles automatiquement dans un classeur a partir d'une liste et lien hypertexte
Réponses
6
Affichages
675
Phil69970
J
  • Question Question
Microsoft 365 Création fiche suivi de véhicules
Réponses
9
Affichages
975
sylvanu
N
  • Question Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
832
Nel'
N
C
  • Résolu(e)
XL 2016 Objets Excel de type feuille dupliqués en x exemplaires suite à plantage
Réponses
6
Affichages
494
TooFatBoy
S
  • Résolu(e)
XL 2016 copier des données d'une feuille à une autre selon critères et protection de la feuille 1
Réponses
6
Affichages
751
steph_29120
S
A
  • Résolu(e)
Microsoft 365 Alimenter automatiquement un tableau à partir des données d'un autre tableau en fonction d'un critère
Réponses
9
Affichages
1 K
Alexandrax971
A
S
  • Question Question
Autres liste déroulante dynamique à 2 niveaux
Réponses
2
Affichages
286
saralht
S
O
  • Question Question
XL 2021 Mise à jour automatique d'une feuille à partir d'une autre
Réponses
9
Affichages
706
Oca
O
P
  • Question Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
761
phoceenjo
P
N
  • Question Question
XL 2019 Aide pour optimiser mon tableau Excel de suivi d'activité
Réponses
6
Affichages
588
Nicolaasss
N
R
  • Question Question
Microsoft 365 aide a la creation d un classeur commercial
2
Réponses
17
Affichages
1 K
Rozey
R
  • Question Question
XL 2021 Remplissage instantané
Réponses
5
Affichages
1 K
sylvanu
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…