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

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

Phil69970

XLDnaute Barbatruc
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: 7
Vote positif 0 Vote négatif

Phil69970

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

Todre

XLDnaute Occasionnel
J'ai quasi tout ok, il me manque juste pour le garage Renault.

Le code actuel:

 
Vote positif 0 Vote négatif

Phil69970

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

Phil69970

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

Phil69970

XLDnaute Barbatruc
Jeu des 4 erreurs
80330 LONGUEAU - GARAGE LAPORTE
ou
80330 LONGUEAU - GARAGE LAPORTE
ou
80330 LONGUEAU - GARAGE LAPORTE
ou
8O330 L0NGUEAU - GARAGE LAPORTE

Réponse ici



Et je te l'ai dit depuis un moment !!!
 
Vote positif 0 Vote négatif

Todre

XLDnaute Occasionnel
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.

Discussions similaires

N
  • Question
Microsoft 365 Remplissage automatique d'une feuille à l'autre
Réponses
2
Affichages
220
Nonoo
N
P
  • Résolu(e)
Microsoft 365 [RESOLUE] Incrémenter avec plusieurs lignes
Réponses
10
Affichages
201
Peio64
P
J
  • Question
Microsoft 365 Création fiche suivi de véhicules
Réponses
9
Affichages
690
sylvanu
D
  • Résolu(e)
Microsoft 365 Remplissage colonne automatique dépendant d'un tableau
Réponses
7
Affichages
544
fanfan38
S
  • Question
Autres liste déroulante dynamique à 2 niveaux
Réponses
2
Affichages
104
saralht
S
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
475
Phil69970
C
  • Résolu(e)
XL 2016 Objets Excel de type feuille dupliqués en x exemplaires suite à plantage
Réponses
6
Affichages
381
TooFatBoy
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
973
Alexandrax971
A
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
421
steph_29120
S
N
  • 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
444
Nel'
N
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…