Export de ligne automatiquement d'une feuille vers une autre

Bonsoir,

Je cherche à effectuer un transfert de ligne d'une feuille à une autre dans un même classeur. J'ai déjà vu un sujet de ce type sur ce forum qui utilise VBA, mais je n'arrive pas à l'adapter à mon projet...

Dans le fichier exemple ci-joint, je chercherai à passer les données de la feuille "Data" vers la feuille "Jan", quand les lignes de la feuille "Data" passent en état "Validé". Elle s'incrémenteront directement à la suite des saisies de la feuille "Jan", à la suite des autres affaires saisies (au dessus des totaux)

J'avais prévu de relier cela à un bouton et d'y affecter la macro.

Les données au niveau de la colonne violette dans la feuille "Data" doivent se retrouver au niveau des cases violettes de la feuille "Jan".

Je ne sais pas si j'ai été clair, mais je vous remercie d'avance pour votre aide!

Bonjour,

Personne n'a indice ? Voici le code que j'ai essayé d'adapter à mon projet sans succès

Dim tableauJan, tableauData(), i&, j&, kData&,

Sub Exporter_vers_JAN ()

tableauEXE = Range("A5:I" & Range("A" & Rows.Count).End(xlUp).Row)
kAO = 1

For i = 1 To UBound(tableauJan, 1) 'Ubound (tableauJan,1)
If tableauData(i, 8) = "Validé" Then
ReDim Preserve tableauData(1 To 1, 1 To kData + 1)

For j = 1 To 1
tableauData(j, kData) = tableauJan(i, j)

Next j

For j = 3 To 5
ReDim Preserve tableauData(1 To 1, 1 To kData + 1)
tableauData(j, kData) = tableauJan(i, j)

Next j
For j = 8 To 8
ReDim Preserve tableauData(1 To 1, 1 To kData + 1)
tableauData(j, kData) = tableauJan(i + 1, j)

Next j
For j = 2 To 2
tableauData(j, kData) = tableauJan(i + 6, j)

Next j

End If
Next i
Sheets("Data").Range("A5").CurrentRegion.Offset(1, 0).ClearContents
Sheets("Data").Range("A6").Resize(UBound(tableauAO, 2), 9) = Application.Transpose(tableauData)
End Sub

Bonjour,

Je n'ai pas bien compris votre code. Voici une proposition (sans incrémentation ni modification des données). La macro s'exécute dès qu'une cellule de la colonne H de la feuille Data passe en "Validé". On copie alors les valeurs des colonnes A à I de la ligne pour les coller à la suite des valeurs de la feuilles Jan (en A à I également) :

private sub worksheet_change(byval target as range)
set r = intersect(target, columns(8))
if not r is nothing then
    for each cell in r
        if cell.value = "Validé" then Transfert target.row, "Jan"
    next cell
end if
end sub

Sub Transfert(ligne&, NomFeuille$)
tdata = sheets("Data").Range("A:I").rows(ligne).value
with sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    .range("A:I").rows(nvl).value = tdata
end with
End Sub

Cdlt,

Bonjour 3GB,

Merci pour votre retour.

J'ai une question à propos de ce code :

- Ayant déjà une macro d'insertion de ligne sur mes onglets commençant par " Worksheet_Change", en rajoutant votre code il est écrit " Nom ambigu".

Comment je peux le régler ce problème svp ?

De plus, je me suis peut-être mal exprimé, mais j'aimerai que seules les colonnes "C" à "G" soient copiées à l'identique ( de "Data" vers "Jan"), que la colonne "H" de la feuille "Data" soit copiée sur la colonne "I" de la feuille "Jan" et que que la colonne "B" de la feuille "Data" soit copiée sur la colonne "H" de la feuille "Jan"

Merci d'avance pour votre aide

cdlt,

Re,

Pour contourner le problème, il faut rajouter (dans la macro worksheet_change) à la suite du code pré-existant cette partie :

dim r as range, cell as range
set r = intersect(target, columns(8))
if not r is nothing then
    for each cell in r
        if cell.value = "Validé" then Transfert target.row, "Jan"
    next cell
end if

Pour l'autre problème :

Sub Transfert(ligne&, NomFeuille$)
dim nvl as long
with sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    .range("C:G").rows(nvl).value = sheets("Data").Range("C:G").rows(ligne).value
    .cells(nvl, "I").value = sheets("Data").cells(ligne, "H").value
    .cells(nvl, "H").rows(nvl).value = sheets("Data").cells(ligne, "B").value
end with
End Sub

Cdlt,

Bonsoir,

Merci pour le code, mais maintenant j'ai un problème de variable. En essayant " Dim r as integer" par exemple, ça ne fonctionne pas.

Je vous joins le fichier avec les macros

Encore merci,

Cdlt

Bonjour,

Je viens d'éditer mon précédent commentaire pour rajouter les déclarations des variables dans le code.

Cdlt,

Bonjour,

Le code fonctionne bizarrement, comme le montre la capture suivante :

j'ai alors remplacé la dernière ligne du code comme ceci et ça fonctionne. J'attends votre avis sur ce code redéfini

Sub Transfert(ligne&, NomFeuille$)
dim nvl as long
with sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    .range("C:G").rows(nvl).value = sheets("Data").Range("C:G").rows(ligne).value
    .cells(nvl, "I").value = sheets("Data").cells(ligne, "H").value
    .cells(nvl, "H").value = sheets("Data").cells(ligne, "B").value
end with
End Sub

Cependant il y a quelques problèmes :

- Quand je rajoute une ligne "validé" au tableau de la feuille "Data", cette dernière prends la place de la ligne déjà en place

- J'aimerai que les valeurs copiées soient au dessus des totaux (voir image ci-dessus) et que le copie de ligne se fasse à la suite de l'existant du tableau "Jan"

Sur le dernier essai de code, il n'y avait que ce problème, mais parfois il y une problème d'intersect global, je vais essayer de ne pas trop y toucher à l'avenir.

Merci et cdlt

Bonjour,

C'est un manque de vigilance de ma part (j'ai copié/collé et oublié de modifier correctement cette partie) mais votre modification est très bien.

- Quand je rajoute une ligne "validé" au tableau de la feuille "Data", cette dernière prends la place de la ligne déjà en place

R : Ce n'est pas normal. Normalement, elle est copiée sur la première ligne non vide. Cela veut dire qu'il faut appliquer la méthode end sur une autre colonne que la A (la C par exemple) :

nvl = .cells(.rows.count, "C").end(xlup).row + 1

C'est un détail que je ne connaissais pas à l'écriture du code.

Cela dit, il ne faut pas avoir de colonne vide inutile et il faut mettre les données sous forme de tableau structuré pour un utilisation optimisée !!!

- J'aimerai que les valeurs copiées soient au dessus des totaux (voir image ci-dessus) et que le copie de ligne se fasse à la suite de l'existant du tableau "Jan"

R : Il faut un tableau structuré !

parfois il y une problème d'intersect global

R : Je ne comprends pas bien. Il peut y avoir des problèmes avec l'évènement change, notamment lors de suppression de lignes.

Voici un nouvel essai avec un tableau structuré nommé "Jan" :

Sub Transfert(ligne&, NomTableau$)
dim nvl as long
with range(NomTableau)
    nvl = .rows.count + 1
    .listobject.listrows.add
    .cells(nvl, 2).resize(, 5).value = sheets("Data").Range("C:G").rows(ligne).value
    .cells(nvl, 8).value = sheets("Data").cells(ligne, "H").value
    .cells(nvl, 7).value = sheets("Data").cells(ligne, "B").value
end with
End Sub

Cdlt,

Bonjour,

J'ai maintenant un problème avec "ListObjects.listrows.add" qui dit "que les propriété ou les méthodes ne sont pas généré cet l'objet" alors que je suis en tableau structuré...

Pour le premier code que vous m'avez proposé, j'ai un problème d'argument ou appel de procédure incorrect et qui me renvoie à l'intersect de la feuille "Jan"...

Je ne comprends pas, je suis en tableau structuré depuis le début, après que vous m'ayez suggéré de le faire après mon premier sujet sur l'insertion de ligne, et les cases se copient sous la case des totaux...

Depuis hier soir j’essaie de comprendre d'où peut provenir les bugs mais sans succès. Peut-être que je recopie mal les codes ? je vous les joins ci-dessous

2ème code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.ListObjects(1).ListColumns(1).DataBodyRange) Is Nothing Then
If Not IsEmpty(Target) Then
Me.ListObjects(1).ListRows.Add
End If
End If

Dim r As Range, cell As Range
Set r = Intersect(Target, Columns(9))
If Not r Is Nothing Then
    For Each cell In r
        If cell.Value = "Validé" Then Transfert Target.row, "Jan"
    Next cell
End If

End Sub

Public Sub CleanTable()

If Not Me.ListObjects(1).DataBodyRange Is Nothing Then Me.ListObjects(1).DataBodyRange.Delete
End Sub

Sub Transfert(ligne&, Jan$)
Dim nvl As Long
With Sheets(Jan)
    nvl = Rows.Count + 1
    .ListObjects.ListRows.Add
    .Range("C:G").Resize(, 5).Value = Sheets("Data").Range("C:G").Rows(ligne).Value
    .Cells(nvl, "I").Value = Sheets("Data").Cells(ligne, "H").Value
    .Cells(nvl, "H").Value = Sheets("Data").Cells(ligne, "B").Value
End With
End Sub

1er code
Sub Transfert(ligne&, Jan$)
Dim nvl As Long
With Sheets(Jan)
    nvl = .Cells(.Rows.Count, "C").End(xlUp).row + 1
    .Range("C:G").Rows(nvl).Value = Sheets("Data").Range("C:G").Rows(ligne).Value
    .Cells(nvl, "I").Value = Sheets("Data").Cells(ligne, "H").Value
    .Cells(nvl, "H").Value = Sheets("Data").Cells(ligne, "B").Value
End With
End Sub

Merci et bonne journée

Bonjour,

Le mieux serait que tu essaies les codes que je te propose ou alors que tu ne gardes que les codes que d'autres te donnent. Sinon, forcément, en mélangeant, ça pose problème...

Je t'invite à relire nos échanges si tu cherches à reconstituer le code que j'ai proposé, tout y est, sauf d'éventuels petits pépins de colonnes (mais j'espère que tu parviendras à adapter).

Et pour ma part, je ne conçois pas de solution sans un tableau structuré...

Cdlt,

Bonjour,

Tout d'abord, désolé pour mon retour tardif.

Le code fonctionne parfaitement avec mes modifs sur mon tableau. Merci !

Deuxièmement, mon projet ayant énormément bougé ainsi que sa disposition : Ajout de l'onglet "Validation" dans la feuille "Data" qui ajoutera la date du jour quand l'état passera à "Validé".

Par conséquent, Les lignes de la feuille "Data" doivent maintenant se copier dans la feuille "Jan" si les dates de "Validation" sont dans le mois de Janvier, copie vers la feuille "Fév" si les dates de "Validation" sont dans Février,....jusqu'à Décembre.

J'ai pensé à copier le code que vous m'avez fourni 12 fois, en changeant le nom de la feuille. Est-ce une bonne idée ?

J'ai essayé, mais je ne sais pas comment inclure la date de validation pour que la ligne correspondante soit copiée dans la bonne feuille...

dim r as range, cell as range
set r = intersect(target, columns(8))
if not r is nothing then
    for each cell in r
        if cell.value = "Validé" then Transfert target.row, "Jan"
    next cell
end if

Sub Transfert(ligne&, NomFeuille$)
dim nvl as long
with sheets(NomFeuille)
    nvl = .cells(.rows.count, 1).end(xlup).row + 1
    .range("C:G").rows(nvl).value = sheets("Data").Range("C:G").rows(ligne).value
    .cells(nvl, "I").value = sheets("Data").cells(ligne, "H").value
    .cells(nvl, "H").rows(nvl).value = sheets("Data").cells(ligne, "B").value
end with
End Sub

Merci d'avance pour votre aide,

Cdlt,

Bonjour Shoto,

Merci pour ce retour. Je suis content que ça fonctionne finalement.

Si le nom d'onglet commence à chaque fois par les 3 premiers caractères du mois de validation, tu peux faire :

dim r as range, cell as range
set r = intersect(target, columns(8))
if not r is nothing then
    for each cell in r
        if cell.value = "Validé" then Transfert target.row, left(range("refcellulecontenantmois"), 3)
    next cell
end if

où

range("refcellulecontenantmois") '<<< REMPLACER PAR LA REFERENCE !

est la cellule contenant le nom du mois de destination.

Et si cette date se trouve sur la ligne de la cible, il faut la cibler de cette façon :

cells(target.row, col) 'où col est la colonne en question (avec les mois)

Cdlt,

Bonsoir 3GB,

Merci pour votre réaction rapide.

J'ai appliqué le code que vous m'avez fourni. Aucun problème, il fonctionne. La première date de la colonne "Validation"commençant à la cellule C5, je l'ai inséré votre formule.

Private Sub Worksheet_Change(ByVal Target As range)
Dim r As range, cell As range
Set r = Intersect(Target, Columns(10))
If Not r Is Nothing Then
    For Each cell In r
        If cell.Value = "Validé" Then Transfert Left(range("C5"), 3)
    Next cell

    End If

Cependant, pour la 2ème partie du code, comment je pourrais faire pour que la macro sélectionne automatiquement la feuille désirée ? Si je mets "Jan" à la place de NomFeuille$ elle ne se copie que sur la feuille "Jan".

Je dois recopier le code 12x ? Je vous joins le fichier pour que vous ayez un aperçu de ce que j'ai fais, peut-être que mes explications n'étaient pas claires non plus...

Sub Transfert(ligne&, NomFeuille$)
Dim nvl As Long
With Sheets("NomFeuille")
    nvl = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .range("D:H").Rows(nvl).Value = Sheets("Data").range("D:H").Rows(ligne).Value
    .Cells(nvl, "I").Value = Sheets("Data").Cells(ligne, "I").Value
    .Cells(nvl, "H").Value = Sheets("Data").Cells(ligne, "B").Value
    .Cells(nvl, "A").Value = Sheets("Data").Cells(ligne, "C").Value
End With
End Sub

A vous lire,

Merci et Cdlt,

Le fichier...

Re Shoto,

Si j'ai bien compris. La seule chose que je ne sais pas, c'est où se trouve la cellule affichant le mois de destination. Soit elle est sur la ligne de la target du changement (pour l'exemple en colonne 26), alors il faut ce code :

Private Sub Worksheet_Change(ByVal Target As range)
dim r as range, cell as range
set r = intersect(target, columns(10))
if not r is nothing then
    for each cell in r
        if cell.value = "Validé" then Transfert target.row, left(cells(target.row, 26), 3)
    next cell
end if
end sub

Soit elle est en C5, alors il faut ce code :

Private Sub Worksheet_Change(ByVal Target As range)
dim r as range, cell as range
set r = intersect(target, columns(10))
if not r is nothing then
    for each cell in r
        if cell.value = "Validé" then Transfert target.row, left(range("C5"), 3)
    next cell
end if
end sub

Cela exécutera en fonction de la valeur de C5 (les 3 premiers caractères), la macro suivante :

Sub Transfert(ligne&, NomFeuille$)
Dim nvl As Long
With Sheets(NomFeuille) ' !!! <<< SANS GUILLEMET CAR C'EST UNE VARIABLE (LE NOM DE LA FEUILLE DE DESTINATION !)
    nvl = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .range("D:H").Rows(nvl).Value = Sheets("Data").range("D:H").Rows(ligne).Value
    .Cells(nvl, "I").Value = Sheets("Data").Cells(ligne, "I").Value
    .Cells(nvl, "H").Value = Sheets("Data").Cells(ligne, "B").Value
    .Cells(nvl, "A").Value = Sheets("Data").Cells(ligne, "C").Value
End With
End Sub

Cette macro a des variables comme paramètres (obligatoires). Le second est NomFeuille, il sera donc remplacé par left(range("C5"), 3), qui peut valoir "Jan" ou "Fév", ...

De cette manière, le code est factorisé.

Cdlt,

Bonjour 3GB,

Le code fonctionne Merci !

Dernier détail, si dans ma colonne 26 (pour reprendre votre exemple) je rentre une date de type "13/04/2021", le code bog, et c'est normal.

Je dois donc redéfinir l'expression suivante ?

Left(Cells(Target.Row, 3), 3)

Ou définir que pour chaque valeur littérale des mois, ces derniers doivent se transformer en valeur numérique du type "13/04/2021" pour que la valeur numérique soit copiée ?

Bonne journée et cdlt,

Bonjour Shoto,

Donc si je comprends bien, il y a des dates en colonne 3 ? A priori en modifiant ainsi cette partie :

Left(application.proper(format(Cells(Target.Row, 3), "MMMM")), 3)

Ca devrait aller.

Ici, on met la date au format MMMM (on obtient alors les mois sous leur valeur textuelle) :

format(Cells(Target.Row, 3), "MMMM")

On convertit en nom propre pour que le premier caractère devienne une majuscule :

application.proper(format(Cells(Target.Row, 3), "MMMM"))

Puis en demande les 3 premiers caractères du résultat (ex : Janvier) obtenu :

Left(application.proper(format(Cells(Target.Row, 3), "MMMM")), 3)

Cdlt,

Bonjour 3GB,

C'est parfait ça fonctionne !

Et dernier détail, Avec votre code

Left(Application.Proper(Format(Cells(Target.Row, 9), "MMMM")), 3)

dans le cas où 2 onglets de mois partagent les mêmes lettres, à savoir Juin et Juillet ("Jui" et "Jui") et si je veux renommer Juillet en "Juil", le code copiera pas les valeurs dans le mois de Juillet mais dans Juin.

Merci d'avance et Cdlt,

Oui, c'est sûr...

Mais ce sont les noms d'onglet tels que vous me les avez présentés. Personnellement, j'aurais des noms d'onglet de type AAMM (2101, ..., 2112).

Dans ce cas, aucun risque de confusion, tout est clair et l'année est prise en compte également. Il faudrait alors ce bout de code à la place du left :

format(Cells(Target.Row, 3), "YYMM")

Cdlt,