Remplissage automatique de tableau entre deux feuilles Excel
Bonjour,
J'ai une problématique sur un outils que je souhaite mettre en place dans mon entreprise. Voici ce que je souhaite faire:
1) Pour chaque ligne du tableau 1 de la feuille "EXTRACTION GX" (ci-dessous), prendre le nom de tâche ( Tâche court en rouge) et le numéro de devis associé (Devis n° en bleu)
2) Les copier
3) Les coller dans le second tableau vierge de la feuille "ACCEPTANCE SHEET 2" (ci-dessous) selon leur emplacement prévus: Work specification pour le nom de tâche en rouge et Quote number pour Devis n° en bleu.
4) Incrémenter au fur et a mesure en créant une ligne dans le tableau vierge identique à la précédente et centrer le texte dans les cellules.
5) Si dans la colonne A ( N° Tâche) il y a un 1, un 2 ou un 3. Ne pas copier/coller et passer à la suite.
Par exemple, pour bien comprendre ce que je souhaite:
- Appuyer sur bouton Acceptance Sheet de la feuille 1
- Pour les trois premières lignes on obtient dans le tableau ceci:
J'avais commencé quelque chose mais ça bloque:
Sub AccS()
Sheets("ACCEPTANCE SHEET 2").Rows("11:" & Sheets("ACCEPTANCE SHEET 2").Range("B" & Rows.Count).Row).Clear
Sheets("ACCEPTANCE SHEET 2").Range("A10") = ""
Sheets("ACCEPTANCE SHEET 2").Range("B10") = ""
ligne = Sheets("ACCEPTANCE SHEET 2").Range("B" & Rows.Count).End(xlUp).Row
i = 2
Do While i < Sheets("EXTRACTION GX").Range("B" & Rows.Count).End(xlUp).Row + 1
If ligne > 19 Then
If Sheets("EXTRACTION GX").Cells(i, 1).Value = 1 Or Sheets("EXTRACTION GX").Cells(i, 1).Value = 2 Or Sheets("EXTRACTION GX").Cells(i, 1).Value = 3 Then
i = i + 1
End If
Sheets("ACCEPTANCE SHEET 2").Range("B" & ligne & ":B" & ligne).EntireRow.Copy Sheets("ACCEPTANCE SHEET 2").Range("B" & ligne + 1).EntireRow
Sheets("ACCEPTANCE SHEET 2").Range("B" & ligne + 1 & ":B" & ligne + 1).ClearContents
End If
Sheets("ACCEPTANCE SHEET 2").Range("B" & ligne + 1).Value = Sheets("EXTRACTION GX").Range("B" & i).Value
If Sheets("EXTRACTION GX").Range("D" & i) <> "" Then
Sheets("ACCEPTANCE SHEET 2").Range("A" & ligne + 1).Value = Sheets("EXTRACTION GX").Range("D" & i).Value
Else
Sheets("ACCEPTANCE SHEET 2").Range("A" & ligne + 1).Value = "-"
End If
Sheets("ACCEPTANCE SHEET").Activate
With Sheets("ACCEPTANCE SHEET 2").Range("A1:A10000")
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
With Sheets("ACCEPTANCE SHEET 2").Range("B16:B10000")
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
Sheets("EXTRACTION GX").Activate
End Sub
Vous trouverez également mon fichier avec le code VBA.
Merci par avance pour votre aide,
Bonsoir ponchorabane, le forum,
Je ne vois pas l'utilité des cases à cocher...si c'est validé, on rentre une date, non ?
J'ai également viré les cellules fusionnées.
Une façon de procéder : ( macro associée au bouton 'Acceptance Sheet')
Sub AcceptanceS()
Dim tb, tbR(), i%, k%, derlig%, lig%
Application.ScreenUpdating = False
With Sheets("EXTRACTION GX")
tb = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row)
k = 0
For i = 1 To UBound(tb, 1)
If tb(i, 4) <> "" Then
ReDim Preserve tbR(1 To 4, 1 To k + 1)
tbR(1, 1 + k) = tb(i, 4)
tbR(2, 1 + k) = tb(i, 2)
tbR(3, 1 + k) = "Date : …................."
tbR(4, 1 + k) = "Date : …................."
k = 1 + k
End If
Next i
On Error Resume Next
With Sheets("ACCEPTANCE SHEET 2")
lig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & lig).Resize(UBound(tbR, 2), 4) = Application.Transpose(tbR)
derlig = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("9:" & derlig).RowHeight = 62.25
.Rows("9:" & derlig).HorizontalAlignment = xlCenter
.Rows("9:" & derlig).VerticalAlignment = xlCenter
.Range("A9:G" & derlig).Borders.LineStyle = xlContinuous
.Activate
End With
End With
Erase tb: Erase tbR
End Sub
Cordialement,
Bonjour xorsankukai,
Tout d'abord merci pour ton aide rapide et efficace cela fonctionne très bien.
Je me suis juste rendu compte d'une chose, c'est que je voudrais que le tableau de la feuille ACCEPTANCE SHEET 2 prennent également les nom de tâche de la feuille EXTRACTION GX même si Devis n° (colonne 4) est vide et que les valeurs dans N°tâche (colonne 1) soient différentes de 1,2 ou 3.
Pensez vous que cela soit envisageable ?
Merci et bonne journée,
Bonjour et merci pour ce retour,
je voudrais que le tableau de la feuille ACCEPTANCE SHEET 2 prennent également les nom de tâche de la feuille EXTRACTION GX même si Devis n° (colonne 4) est vide et que les valeurs dans N°tâche (colonne 1) soient différentes de 1,2 ou 3.
Autrement dit, si la valeur de la colonne A est >3 ?
'...............DEBUT SUB ACCEPTANCE SHEET 2 ................................
Sub AcceptanceS()
Dim tb, tbR(), i%, k%, derlig%, lig%, dl%
Application.ScreenUpdating = False
With Sheets("EXTRACTION GX")
dl = .Range("A" & Rows.Count).End(xlUp).Row
If dl = 1 Then Exit Sub
tb = .Range("A2:E" & dl)
k = 0
For i = 1 To UBound(tb, 1)
If tb(i, 1) > 3 And IsNumeric(tb(i, 1)) Then
ReDim Preserve tbR(1 To 4, 1 To k + 1)
tbR(1, 1 + k) = tb(i, 4)
tbR(2, 1 + k) = tb(i, 2)
tbR(3, 1 + k) = "Date : …................."
tbR(4, 1 + k) = "Date : …................."
k = 1 + k
End If
Next i
On Error Resume Next
With Sheets("ACCEPTANCE SHEET 2")
lig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & lig).Resize(UBound(tbR, 2), 4) = Application.Transpose(tbR)
derlig = .Range("B" & Rows.Count).End(xlUp).Row
.Rows(lig & ":" & derlig).RowHeight = 62.25
.Rows(lig & ":" & derlig).HorizontalAlignment = xlCenter
.Rows(lig & ":" & derlig).VerticalAlignment = xlCenter
.Range("A" & lig & ":G" & derlig).Borders.LineStyle = xlContinuous
.Activate
End With
End With
Erase tb: Erase tbR
End Sub
'...............FIN SUB ACCEPTANCE SHEET................................
Cordialement,
Alors le but de ce bouton est que pour chaque n°devis présent dans la colonne 4 de la feuille EXTRACTION GX, il copie le nom de tâche (Tâche court) et le numéros de devis (Devis n°) pour chaque ligne et les colle dans les colonnes 1 et 2 du tableau de ACCEPTANCE SHEET 2.
Cependant, parfois il n'y a pas de n°devis dans la colonne et je souhaiterait qu'il copie quand même les noms de tâche associés avec pour conditions que la valeur pour ce même nom dans la colonne 1 (N°Tâche) soit différente de 1, 2 ou 3.
Pour expliquer, s'il y a cette valeur dans la colonne 1 c'est que le nom de tâche a un statut particulier mais cela n'entre pas dans le sujet.
Par exemple, dans le fichier que je vous ai envoyé, il devrait y avoir dans le tableau de la feuille ACCEPTANCE SHEET 2 après avoir appuyé sur le bouton:
QUOTE NUMBER WORKS SPECIFICATION
Devis n°1 UNSTEPPING
Devis n°3 HAULING
Devis n°24 Bonbords
etc.
C'est peut-être plus clair pour vous ?
D'ailleurs est-il possible dans la colonne 1 de ACCEPTANCE SHEET de ne pas mettre "DEVIS N°" avant chaque numéros dans les cellules ?
Merci en tout cas
Re,
D'ailleurs est-il possible dans la colonne 1 de ACCEPTANCE SHEET de ne pas mettre "DEVIS N°" avant chaque numéros dans les cellules ?
A tester....
'...............DEBUT SUB ACCEPTANCE SHEET 2 ................................
Sub AcceptanceS()
Dim tb, tbR(), i%, k%, derlig%, lig%, dl%
Application.ScreenUpdating = False
With Sheets("EXTRACTION GX")
dl = .Range("A" & Rows.Count).End(xlUp).Row
If dl = 1 Then Exit Sub
tb = .Range("A2:E" & dl)
k = 0
For i = 1 To UBound(tb, 1)
If tb(i, 1) > 3 And IsNumeric(tb(i, 1)) Then
ReDim Preserve tbR(1 To 4, 1 To k + 1)
tbR(1, 1 + k) = Mid(tb(i, 4), 9)
tbR(2, 1 + k) = tb(i, 2)
tbR(3, 1 + k) = "Date : …................."
tbR(4, 1 + k) = "Date : …................."
k = 1 + k
End If
Next i
On Error Resume Next
With Sheets("ACCEPTANCE SHEET 2")
lig = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & lig).Resize(UBound(tbR, 2), 4) = Application.Transpose(tbR)
derlig = .Range("B" & Rows.Count).End(xlUp).Row
.Rows(lig & ":" & derlig).RowHeight = 62.25
.Rows(lig & ":" & derlig).HorizontalAlignment = xlCenter
.Rows(lig & ":" & derlig).VerticalAlignment = xlCenter
.Range("A" & lig & ":G" & derlig).Borders.LineStyle = xlContinuous
.Activate
End With
End With
Erase tb: Erase tbR
End Sub
'...............FIN SUB ACCEPTANCE SHEET................................
Cordialement,
J'ai essayé et ça marche nickel !
Part contre, j'ai essayé sur un plus gros tableau avec plus de donnée et la première tâche n'apparait pas dans mon tableau de ACCEPTANCE SHEET.
La première ligne ne correspond pas à celle du tableau de EXTRACTION GX.
De plus, serait il possible de remettre les cases à cocher supprimées et de les incrémenter à chaque ligne lorsqu'on génère le tableau s'il vous plait ?
Vous m'aidez grandement en tout cas
Cordialement
Re,
J'ai eu le même souci avec ton fichier de départ, la fusion entre les lignes 8 et 9 fausse la définition de la première ligne vide.
lig = .Range("A" & Rows.Count).End(xlUp).Row + 1
Excel doit interpréter la première ligne vide comme étant la 9....
Tu me diras qu'il suffit de mettre + 2 : effectivement, mais si tu rajoutes des lignes par la suite, on aura 1 ligne vide à chaque fois.
J'ai donc fait au plus simple, et comme il est fortement déconseillé de fusionner des cellules....car source de problème...j'ai préféré la virer,
Crdlt,
Re,
On peut ruser ....
J'ai écrit un texte en D9 (j'ai changé la couleur de la police pour qu'il n'apparaisse pas).
On peut alors définir :
lig = .Range("D" & Rows.Count).End(xlUp).Row + 1
Crdlt,
Re,
Merci pour ton retour. Malheureusement, cela ne fonctionne toujours pas
Je n'ai toujours pas la première ligne de mon tableau de la feuille EXTRACTION GX à la première de mon tableau de la feuille ACCEPTANCE SHEET..
Cordialement
Voici un fichier avec plus de données et le code ajouté.
Comment peut on faire pour refaire apparaitre les case à cocher ?
Merci
Re,
Je n'ai toujours pas la première ligne de mon tableau de la feuille EXTRACTION GX à la première de mon tableau de la feuille ACCEPTANCE SHEET..
Ça ne fonctionne pas car tu n'as pas de texte en D9....
Comment peut on faire pour refaire apparaitre les case à cocher ?
Désolé, je ne maitrise pas ces cases à cocher....
Ceci dit, on peut ruser, à supposer qu'on aura toujours la première ligne avec les cases à cocher, il suffit alors de les "tirer" jusqu'à le dernière ligne...
Cela implique que si tu supprimes les données de ton tableau, il faudra conserver C10:D10 et F10:G10....
Crdlt,
Parfait ça fonctionne merci beaucoup !!!
Bonjour,
Une nouvelle problématique est apparue sur le sujet. J'ai fusionné les lignes aux colonnes D8 D9 et E8 E9 et évidemment, le programme ne fonctionne plus très bien.
Est il possible d'ajouter une variante au code pour pouvoir résoudre ce soucis s'il vous plait ?
Sinon dans l'ensemble c'est parfait tout fonctionne parfaitement.
Merci par avance,
Cordialement,
Bonjour,
La fusion des lignes 8 et 9 est inutile, il suffit d'augmenter la hauteur de la ligne pour obtenir le même rendu.
Cordialement,