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" &...

Phil69970

XLDnaute Barbatruc
Je te propose

Dans le code "Sub info" tu rajoutes ces lignes

1704809309151.png


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
    1704809300103.png
    71.9 KB · Affichages: 6

Phil69970

XLDnaute Barbatruc
Et pour ta dernière demande

Je te propose

Dans le code "Sub info" tu rajoutes ces lignes

1704812954987.png


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'
 

Todre

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

Le code actuel:

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

.Range("A" & i & ":L" & i).Interior.ColorIndex = 4
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 = ActiveWorkbook.Path & "\"
'Chemin = "C:\Users\VL6229\OneDrive - GRDF\Bureau\Bon Véhicules\2024" & "\" 'Chemin en dur dans le code
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
 

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:

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
 

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 :)
 

Discussions similaires

Statistiques des forums

Discussions
313 322
Messages
2 097 141
Membres
106 851
dernier inscrit
Rv34