VBA Copie ligne précédente tableau avec combobox date

Version imprimable

29/10/2014, 18h08
joel50

1 pièce(s) jointe(s)

Bonjour
J'ai créé, avec de l'aide, une macro qui copie la dernière ligne d'un tableau.
Je souhaiterai pouvoir changer la date de la 1er feuille à partir d'une date saisie dans une textbox.
Dans le meilleur des cas, il me rajoute bien le copie de la ligne précédente, mais bloque à la modification de date dans le tableau.
Ci-joint fichier exemple.
Merci de votre aide
Joël

Bonsoir

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ajoutavecdate()
 
Dim a, i As Byte
Dim Dt As Date
Dt = InputBox("Entrer une date")
a = Split("Données;Données2", ";")
For i = 0 To UBound(a)
  With Sheets(a(i)).ListObjects(1).Range
    .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1)
    .Cells(.Rows.Count + 1, 1) = Dt
  End With
Next i
 
End Sub

29/10/2014, 19h02
joel50

1 pièce(s) jointe(s)

Bonsoir
Merci de l'aide
Ça réponds quasiment à mon objectif. Juste que je souhaite pour une question d'organisation et de fiabilité sur mon fichier initial (qui contient 5 feuilles) que la date fasse référence à celles de la première feuille au lieu d'être copiée à partir de la message box.

J'ai tenté à partir du code d'un userform, mais je bloque.
Joël

Bonjour :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ajoutavecdate()
 
Dim a, i As Byte
Dim Dt As Date
 
'Modification :
Dt = Worksheets("MaFeuille").Range("A1").value
 
a = Split("Données;Données2", ";")
For i = 0 To UBound(a)
  With Sheets(a(i)).ListObjects(1).Range
    .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1)
    .Cells(.Rows.Count + 1, 1) = Dt
  End With
Next i
 
End Sub

1 pièce(s) jointe(s)

Bpjour Nico chg
Merci de l'aide

Je ne parviens pas à la faire fonctionner
Sans messagebox ou userform/textbox,je ne peux pas saisir de date.
Si je mets la messagebox en début, il me copie bien la ligne mais sans date.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub ajoutavecdate() Dim a, i As Byte Dim Dt As Date Dt = InputBox("Entrer une date") 'Modification : Dt = Worksheets("Feuil1").Range("A1").Value a = Split("Données;Données2", ";") For i = 0 To UBound(a) With Sheets(a(i)).ListObjects(1).Range .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1) .Cells(.Rows.Count + 1, 1) = Dt End With Next i End Sub
Si je la mets en dessous de Dt=Wokrsheets....
Il me copie bien les lignes en bas de chaque tableau mais supprme la formule en première colone de la page Données2.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub ajoutavecdate() Dim a, i As Byte Dim Dt As Date 'Modification : Dt = Worksheets("Feuil1").Range("A1").Value Dt = InputBox("Entrer une date") a = Split("Données;Données2", ";") For i = 0 To UBound(a) With Sheets(a(i)).ListObjects(1).Range .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1) .Cells(.Rows.Count + 1, 1) = Dt End With Next i End Sub
Peut être me suis-je mal exprimé en parlant de macro, ce que j'ai besoin et qui sera réutilisable pour un autre formulaire que je souhaite développer après, c'est le fonctionnement du Userform appelé par le bouton 3 du fichier joint.
Il faudrait que, le code recopie la dernière ligne de chaque tableau (il y en en pour l'instant 5 dans mon classeur de travail), ce qui fonctionne avec la macro que j'ai mis en exemple (1er bouton) et qu'ensuite il transfère la date de la textbox" txtDate en 1ere colonne de la première feuille (données dans l'exemple) sans modifier les 1ere colonnes des feuilles suivante.

Code du userform qui ne fonctionne pas, erreur variable non définie
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Option Explicit Dim a, i As Byte Private Sub CmdOk_Click() a = Array("Données", "Données2") For i = 0 To UBound(a) With Sheets(a(i)).ListObjects(1).Range .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1) End With With Sheets("Données").ListObjects("Tab_Données") If .ListRows.Count = 1 And .ListRows(1).Range.Cells(1, 1) = "" Then Set LignTablo = Sheets("Données").ListObjects("Tab_Données").ListRows(1) Else Set LignTablo = Range("Tab_Données").ListObject.ListRows.Add(AlwaysInsert:=True) End If End With With LignTablo.Range .Cells(1, 1) = CDate(TxtDate) End With Next Me.Hide End Sub
Joël

Citation:

Envoyé par joel50

Peut être me suis-je mal exprimé en parlant de macro, ce que j'ai besoin et qui sera réutilisable pour un autre formulaire que je souhaite développer après, c'est le fonctionnement du Userform appelé par le bouton 3 du fichier joint.
Il faudrait que, le code recopie la dernière ligne de chaque tableau (il y en en pour l'instant 5 dans mon classeur de travail), ce qui fonctionne avec la macro que j'ai mis en exemple (1er bouton) et qu'ensuite il transfère la date de la textbox" txtDate en 1ere colonne de la première feuille (données dans l'exemple) sans modifier les 1ere colonnes des feuilles suivante.

Je n'ouvre pas les Pièces jointes, donc je n'ai pas toutes les pièces pour comprendre ta problématique !

Mais je dois t'avouer que j'ai lu tout en diagonal, j'ai très mal saisi ta problématique, Mea Culpa! Je te propose donc de recommencer, et d'oublier le code que j'ai proposer, qui n'avance à rien.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub ajoutavecdate() Dim a, i As Byte Dim Dt As Date 'Modification : Dt = InputBox("Entrer une date", , Worksheets("MaFeuille").Range("A1").value) a = Split("Données;Données2", ";") For i = 0 To UBound(a) With Sheets(a(i)).ListObjects(1).Range .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1) .Cells(.Rows.Count + 1, 1) = Dt End With Next i End Sub

31/10/2014, 14h09
Invité

1 pièce(s) jointe(s)

Bonjour,

1 pièce(s) jointe(s)

Bonjour à tous et merci du coup de main

Cela fait déjà plusieurs fois que je modifie ce message.

Nico chg Mea culpa également pour moi, je suis précipiter sur le dernier post, je n'avais pas vu le tient. Il répond à ma demande et il est pour l'instant en fonctionnement sur mon tableur, Merci., au vu de ce qui suit, j'aurai mieux fait de courir un peu moins.

Robert, merci également, comme quoi, le travail sur le post d'hier n'aura pas été vain, réutilisé des aujourd'hui, par contre je ne parvient pas à faire fonctionner les copies de l'ensemble des tableaux, quand j'arrive à quelque chose, c'est la copie du premier sur tous les suivant.

J'ai compiler les 2 codes et ... ben ça marche, je m'étonne moi-même d'y être arrivé.
Ci-dessous le code de mon tableur de travail.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Sub ajoutavecdate() Dim a, I As Byte Dim Dt Dt = Calendard.Chargement(Caption:="Entrer une date") ' InputBox("Entrer une date") If Dt = False Then MsgBox "ERR": Exit Sub a = Split("Data_Système;Data_Troupeau;Data_Lait;Data_Ration;Data_Compta", ";") For I = 0 To UBound(a) With Sheets(a(I)).ListObjects(1).Range .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1) .Cells(.Rows.Count + 1, 1) = TrouveType(Dt) End With Next I End Sub Function TrouveType(V) TrouveType = V If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 And InStr(TrouveType, ":") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd hh:mm"): Exit Function If IsDate(TrouveType) = True And InStr(TrouveType, "/") <> 0 Then TrouveType = Format(TrouveType, "yyyy-mm-dd"): Exit Function If IsNumeric(Replace(TrouveType, ".", ",")) = True Then TrouveType = Replace(TrouveType, ",", "."): Exit Function End Function
Je ne m'étais jamais penché sur le VBA auparavant, c'est effectivement très intéressant, je trouve un intérêt supplémentaire à chaque pas en avant qui m'allège et me sécurise mon tableur et mes données. Par contre, je passe une 1/2 journée à chaque nouveau formulaire ou module. Impossible pour moi sans vos aides à tous, un vrai grand merci.

Question subsidiaire générée par l'utilisation du dernier module : Est il possible de faire quelque chose de similaire mais avec une liste pour supprimer une ligne obsolète ou ajoutée par erreur, ça devient tellement facile de les créer que je pourrait les utiliser pour simulation de calcul facilement mais in faudra que je les supprime ensuite, actuellement je fais mes simul sur des fiches existantes il il m'arrive d'oublier de remettre les bonnes données.
Exemple UsrSuprimer avec liste des dates dans la textbox du fichier joint

Joël

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub ajoutavecdate()
 
Dim a, I As Byte
Dim Dt
Dt = Calendard.Chargement(Caption:="Entrer une date") ' InputBox("Entrer une date")
If Dt = False Then MsgBox "ERR": Exit Sub
With Sheets("Data_Système").ListObjects(1).Range
    .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1)
    .Cells(.Rows.Count + 1, 1) = TrouveType(Dt)
  End With
For I = 1 To Sheets.Count
If InStr(1, Sheets(I).Name, "Data") <> 0 And Sheets(I).Name <> "Data_Système" Then
  With Sheets(I).ListObjects(1).Range
    Sheets("Data_Système").ListObjects(1).Range.Rows(Sheets("Data_Système").ListObjects(1).Range.Rows.Count).Copy .Rows(.Rows.Count + 1)
 
  End With
  End If
Next I
 
End Sub

Bonsoir Robert

J'avais essayé,je ne sais ou est le bug, mais ça me copie les données de la dernière ligne du premier tableau sur tout les tableaux suivants, alors que j'ai besoins de copier leur propre dernière ligne à chacun des tableaux.
j'y suis arrivé avec le code suivant qui est une compil des 2 codes de ce post. J'aurais aimer que le tient fonctionnement, si je l'ai bien compris pour l'évolution, à partir du moment ou je commence mes nouveaux tableaux par Data, il devrai les gérer sans modif.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub ajoutavecdate() Dim a, I As Byte Dim Dt As Date 'Modification : Dt = Calendard.Chargement(Caption:="Entrer une date") ' InputBox("Entrer une date") If Dt = False Then MsgBox "ERR": Exit Sub a = Split("Données;Données2", ";") For I = 0 To UBound(a) With Sheets(a(I)).ListObjects(1).Range .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1) .Cells(.Rows.Count + 1, 1) = Dt End With Next I End Sub
Joël

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ajoutavecdate()
 
Dim a, I As Byte
Dim Dt
Dt = Calendard.Chargement(Caption:="Entrer une date") ' InputBox("Entrer une date")
If Dt = False Then MsgBox "ERR": Exit Sub
 
For I = 1 To Sheets.Count
If InStr(1, Sheets(I).Name, "Data") <> 0 Then
 With Sheets(I).ListObjects(1).Range
    .Rows(.Rows.Count).Copy .Rows(.Rows.Count + 1)
    .Cells(.Rows.Count + 1, 1) = TrouveType(Dt)
  End With
  End If
Next I
 
End Sub

31/10/2014, 21h59
joel50

Re,
Et encore une fois merci, ça marche et c'est déjà prêt pour la suite du classeur, sinon à chaque fois que je bouge quelque chose, c'est n bug et erreur à corriger et j'en retrouve au bout d'un moment.
Depuis 48 heures, j'ai fait (surtout mon tableur) a fait de grand pas en avant, plus vite que j'aurais cru.

Chaque développement en amenant un autre, maintenant je n'arrive pas non plus à finir ma macro qui supprimerai la dernière ligne de tout les tableaux, même problème, soit je bug, soit je ne supprime que sur le premier tableau, et une qui supprime au choix avec un choix de date.
J'ai poster sur:
http://www.developpez.net/forums/d14...t/#post8017528

Cordialement
Joël