Rapatrié donné en VBA? 2 onglets

  • Initiateur de la discussion Initiateur de la discussion jeromeN95
  • 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 !

jeromeN95

XLDnaute Impliqué
Bonjour le forum.
J'ai 2 onglets et je souhaite remplir un tableau dans le 2nd onglet en fonction du 1er.

J'ai mis un exemple dans le fichier joint.

Le 1er tableau (onglet LOCJD) contient une liste d'article avec quantitée...

J'aimerai qu'une fois la selection du 2nd onglet faite (ContratB) alors le tableau "récapitulatif" se remplisse.

Merci a tous.
 

Pièces jointes

Re : Rapatrié donné en VBA? 2 onglets

Bonjour et merci enormement.
I LOVE CANADA !!!!

C'est parfait, marche au poil sauf que j'ai du modifier legèrement car il y a des écrits en dessous du tableau.
Mais ce n'est pas grave.

Voir poste en dessous SVP.
 
Dernière édition:
Re : Rapatrié donné en VBA? 2 onglets

Bonsoir le forum,
je doit malheuresement aporté une modification a ce code .
Et oui, j'ai oublier l'évolution du fichier au sein de son application;-)

Je souhaiterai ajouter une régle :

SI G14 = Clax Revoflow
ou = L5000

Alors faire le code déjà mis en place lorsque l'on clique sur le bouton Contrat Mise à disposition

SI G14 = Dosalinge 5P 20L
ou = Dosalinge 5P 30L
ou = Dosalinge 5P 60L

Alors mettre dans l'onglet "ContratB" :
le nom (de G14 --> en B16)
son code (CM11:CM13 --> en A16),
la quantité (indiquer en F14 à mettre en D16) ainsi que
son prix (se trouve dans l'onglet RBuanderie plage CL11:CL13 à mettre en E16)

Ce serait vraiment génial car je m'embrouille les pinceau dans ce superbe code :


Code:
Private Sub Worksheet_Activate()
Dim c As Range, pSource As Range, pDestination As Range
Dim i As Integer, dTotal As Double
Application.ScreenUpdating = False
Set pSource = Sheets("LOCJD").Range("K27:K54")
Set pDestination = Sheets("ContratB").Range("pDestination") '1re cellule du tableau
'Note : "pDestination" est une cellule nommée dans l'onglet ContratB
i = 1
dTotal = 0
'Vider le tableau
pDestination.Offset(1, 0).Resize(10, 5).ClearContents   '10 car 28 lignes dans LOCJD
pDestination.Offset(1, 0).Resize(10, 5).ClearFormats
'copie dans le 2e tableau
For Each c In pSource
    If c.Value <> "" Then
        pDestination.Offset(i, 0) = c.Offset(0, -10) 'Code produit
        pDestination.Offset(i, 1) = c.Offset(0, -9) 'Nom du produit
        pDestination.Offset(i, 3) = c.Offset(0, 0) 'Quantité
        pDestination.Offset(i, 4) = c.Offset(0, -4) 'Valeur unitaire
        pDestination.Offset(i, 5) = c.Offset(0, 1) 'Valeur totale
        dTotal = dTotal + c.Offset(0, 1)
        i = i + 1
    End If
Next c
'Dernière colonne TOTAL
pDestination.Offset(i + 3, 0) = "Total"
pDestination.Offset(i + 3, 5) = dTotal
'Ajout bordures
' - copier les bordures
pDestination.Copy
pDestination.Offset(1, 0).Resize(i + 3, 6).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
' -enlever bordures intérieures
With pDestination.Offset(1, 0).Resize(i + 2, 6)
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
'Format colonne E et F en montétaire
pDestination.Offset(1, 4).Resize(i + 3, 2).Style = "Currency"
pDestination.Activate
Application.ScreenUpdating = True
End Sub

Je vous met le fichier en PJ, un grand merci.
 

Pièces jointes

Re : Rapatrié donné en VBA? 2 onglets

Bonsoir Jerome,

1)
Comment vas-tu utiliser ce fichier exactement? Je pose la question car au départ tu voulais que le tableau récapitulatif dans ClasseurB quand on sélectionne l'onglet. C'est ce que je t'ai proposé avec la macro.

Par contre, si maintenant tu veux faire ceci :
SI G14 = Dosalinge 5P 20L
ou = Dosalinge 5P 30L
ou = Dosalinge 5P 60L

Alors mettre dans l'onglet "ContratB" :
le nom (de G14 --> en B16)
son code (CM11:CM13 --> en A16),
la quantité (indiquer en F14 à mettre en D16) ainsi que
son prix (se trouve dans l'onglet RBuanderie plage CL11:CL13 à mettre en E16)

Il va y avoir un problème car dès que l'on va sélectionner l'onglet ClasseurB toutes les données seront effacées et remplacées uniquement par celles provenant de LOCJD.

Il faudrait donc que la 1re macro soit exécutée quand on cliquer sur un bouton ou bien qu'on prévoir une ligne pour ce qui provient de "buanderie"

2)
Tu as modifié le nombre de lignes effacées dans la macro à cause des écrits sous le tableau. Je crois que ça va te créer un problème. Par exemple, si tu as 10 quantités d'inscrite dans LOCJD, tu auras un tableau. Si ensuite tu as moins de quantités dans LOCJD, ton tableau ne sera pas effacé correctement.
Fais le test.

Une solution consisterait à avoir un nombre fixe de lignes dans le tableau et masquer celles qui ne sont pas utilisées...

À vérifier.
 
Re : Rapatrié donné en VBA? 2 onglets

Bonjour et merci,
2) en faite le tableur sera enregistrer en modél donc a chaque fois ce sera une nouvelle étude et on ne fera le "remplissage" du tableau "contrat" qu'une seul fois.

1) Justement, il faut travailler avec l'onglet "LOCJD" uniquement si en G14 on a soit L5000 soit Clax Revoflow.
Sinon (Dosalinge 5P 20L, Dosalinge 5P 30L, Dosalinge 5P 60L), on travail avec une rechercheV dans l'onglet "RBuanderie" pour rapatrier les données. (on peut formater une plage même)...
 
Re : Rapatrié donné en VBA? 2 onglets

Hello, j'ai commencer le code, il me reste a faire la rechercheV pour rapatrié les autres données qui sont en RBuanderie (code, prix, réf, ...) :

Code:
Private Sub Worksheet_Activate()
Dim c As Range, pSource As Range, pDestination As Range
Dim i As Integer, dTotal As Double
Application.ScreenUpdating = False
Set pSource = Sheets("LOCJD").Range("K27:K54")
Set pDestination = Sheets("ContratB").Range("pDestination") '1re cellule du tableau
'Note : "pDestination" est une cellule nommée dans l'onglet ContratB
i = 1
dTotal = 0
'Vider le tableau
pDestination.Offset(1, 0).Resize(10, 5).ClearContents   '10 car 28 lignes dans LOCJD
pDestination.Offset(1, 0).Resize(10, 5).ClearFormats
'copie dans le 2e tableau

'SI DOSEUR DIVERSEY Alors faire la PAU et remplir le contrat
If [FOURNISSEUR] = "Diversey" Then
For Each c In pSource
    If c.Value <> "" Then
        pDestination.Offset(i, 0) = c.Offset(0, -10) 'Code produit
        pDestination.Offset(i, 1) = c.Offset(0, -9) 'Nom du produit
        pDestination.Offset(i, 3) = c.Offset(0, 0) 'Quantité
        pDestination.Offset(i, 4) = c.Offset(0, -4) 'Valeur unitaire
        pDestination.Offset(i, 5) = c.Offset(0, 1) 'Valeur totale
        dTotal = dTotal + c.Offset(0, 1)
        i = i + 1
    End If
Next c
End If

'SI DOSEUR ERDEMIL alors faire contrat
If [FOURNISSEUR] = "Hypronorm" Then
    
    Range("F19:F24").Select
    Range("F24").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.ClearContents
    Range("F18").Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Sheets("ContratB").Select
    Range("B15").Select
    Range("B15") = [nomdoseur]
    Range("A15").Select

End If

'Dernière colonne TOTAL
pDestination.Offset(i + 3, 0) = "Total"
pDestination.Offset(i + 3, 5) = dTotal
'Ajout bordures
' - copier les bordures
pDestination.Copy
pDestination.Offset(1, 0).Resize(i + 3, 6).PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
' -enlever bordures intérieures
With pDestination.Offset(1, 0).Resize(i + 2, 6)
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
'Format colonne E et F en montétaire
pDestination.Offset(1, 4).Resize(i + 3, 2).Style = "Currency"
pDestination.Activate
Application.ScreenUpdating = True
End Sub


Une petite idée SVP pour le rapatriage en fonction du nom ?
 
Dernière édition:
- 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

  • Question Question
Microsoft 365 Comparer 2 onglets
Réponses
8
Affichages
672
Réponses
8
Affichages
836
Retour