Discussion :

[joel50]

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

[keygen08]

Bonsoir

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[joel50]

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

[Nico Chg]

Bonjour :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[joel50]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Nico Chg]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

Bonjour,

[joel50]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[joel50]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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