XL 2010 Completer un code VBA RESOLU

virginie75015

XLDnaute Nouveau
Bonjour à tous.

J'ai un code VBA dans un formulaire qui me permet de remplir les données du formulaire dans un tableau sur une feuil qui se nomme GESTION CHANTIER. cela fonctionne à merveille.

le voici :

Code: Option Explicit

Dim ws As Worksheet, a()

Private Sub CommandButton1_Click()
'Ajouter
Dim Ligne As Long

If Trim(Me.TextBox1) = "" Then
MsgBox "Numéro obligatoire"
ElseIf Not IsDate(Me.TextBox9) Then
MsgBox "Date non conforme"
Me.TextBox9 = ""
Me.TextBox9.SetFocus
Else
If ws.Range("A3") <> "" Then
Ligne = ws.Range("A2").End(xlDown).Row + 1
Else
Ligne = 3
End If
ws.Range("A" & Ligne) = Me.TextBox1.Value ' Numéro
ws.Range("B" & Ligne) = Me.TextBox2.Value ' Nom
ws.Range("C" & Ligne) = Me.TextBox3.Value ' Client
ws.Range("D" & Ligne) = Me.TextBox4.Value ' Code
ws.Range("E" & Ligne) = Me.TextBox5.Value ' Lieu
ws.Range("F" & Ligne) = Me.TextBox6.Value ' Code postal et Ville
ws.Range("G" & Ligne) = Me.TextBox7.Value ' Tarif
ws.Range("H" & Ligne) = Me.TextBox8.Value ' Nombre IR
ws.Range("I" & Ligne) = CDate(Me.TextBox9.Value) ' Date
ws.Range("N" & Ligne) = Me.TextBox10.Value ' Jour de protection
ws.Range("O" & Ligne) = Me.TextBox11.Value ' Heure MES/MHS
ws.Range("P" & Ligne) = Me.TextBox12.Value ' Code client
ws.Range("Q" & Ligne) = Me.TextBox13.Value ' Code accès
ws.Range("r" & Ligne) = Me.TextBox17.Value ' cour ou rue
ws.Range("s" & Ligne) = Me.TextBox14.Value ' Contact
ws.Range("t" & Ligne) = Me.TextBox15.Value ' Téléphone
ws.Range("u" & Ligne) = Me.TextBox18.Value ' Commercial
Unload Me

End If
End Sub

Private Sub UserForm_Initialize()
Set ws = Sheets("GESTION CHANTIER")
End Sub

Je cherche absolument à ce que ce code recopie en même temps dans un autre tableau qui est sur la feuil Visu install.
J'ai donc besoin que : (actuellement mon tableau sur la feuil Visu install est rempli, il faut donc que le code commence la recopie à partir de la ligne 243. et à chaque recopie il me faut un row +1

TextBox3 se recopie sur la feuil Visu install en A243
TextBox5 se recopie sur la feuil Visu install en B243
TextBox9 se recopie sur la feuil Visu install en C243

Merci d'avance pour votre aide qui me sera précieuse.

J'ai tenté de vous fournir un exemple, mais quand j'exporte la feuille visu install, j'exporte le formulaire, mais rien ne fonctionne car tout est relié à d'autres feuil.
 

croco40

XLDnaute Occasionnel
Bonjour,
essaie avec ça :
Dim ws As Worksheet, a()

Private Sub CommandButton1_Click()
'Ajouter
Dim Ligne As Long
Ligne2 = sheets("Visu install").range("a65536").end(xlup).rows
If Trim(Me.TextBox1) = "" Then
MsgBox "Numéro obligatoire"
ElseIf Not IsDate(Me.TextBox9) Then
MsgBox "Date non conforme"
Me.TextBox9 = ""
Me.TextBox9.SetFocus
Else
If ws.Range("A3") <> "" Then
Ligne = ws.Range("A2").End(xlDown).Row + 1
Else
Ligne = 3
End If
ws.Range("A" & Ligne) = Me.TextBox1.Value ' Numéro
ws.Range("B" & Ligne) = Me.TextBox2.Value ' Nom
ws.Range("C" & Ligne) = Me.TextBox3.Value ' Client
ws.Range("D" & Ligne) = Me.TextBox4.Value ' Code
ws.Range("E" & Ligne) = Me.TextBox5.Value ' Lieu
ws.Range("F" & Ligne) = Me.TextBox6.Value ' Code postal et Ville
ws.Range("G" & Ligne) = Me.TextBox7.Value ' Tarif
ws.Range("H" & Ligne) = Me.TextBox8.Value ' Nombre IR
ws.Range("I" & Ligne) = CDate(Me.TextBox9.Value) ' Date
ws.Range("N" & Ligne) = Me.TextBox10.Value ' Jour de protection
ws.Range("O" & Ligne) = Me.TextBox11.Value ' Heure MES/MHS
ws.Range("P" & Ligne) = Me.TextBox12.Value ' Code client
ws.Range("Q" & Ligne) = Me.TextBox13.Value ' Code accès
ws.Range("r" & Ligne) = Me.TextBox17.Value ' cour ou rue
ws.Range("s" & Ligne) = Me.TextBox14.Value ' Contact
ws.Range("t" & Ligne) = Me.TextBox15.Value ' Téléphone
ws.Range("u" & Ligne) = Me.TextBox18.Value ' Commercial


sheets(«Visu install»).Range("A" & Ligne2) = Me.TextBox1.Value ' Numéro
sheets(«Visu install»).Range("B" & Ligne2) = Me.TextBox2.Value ' Nom
sheets(«Visu install»).Range("C" & Ligne2) = Me.TextBox3.Value ' Client
sheets(«Visu install»).Range("D" & Ligne2) = Me.TextBox4.Value ' Code
sheets(«Visu install»).Range("E" & Ligne2) = Me.TextBox5.Value ' Lieu
sheets(«Visu install»).Range("F" & Ligne2) = Me.TextBox6.Value ' Code postal et Ville
sheets(«Visu install»).Range("G" & Ligne2) = Me.TextBox7.Value ' Tarif
sheets(«Visu install»).Range("H" & Ligne2) = Me.TextBox8.Value ' Nombre IR
sheets(«Visu install»).Range("I" & Ligne2) = CDate(Me.TextBox9.Value) ' Date
sheets(«Visu install»).Range("N" & Ligne2) = Me.TextBox10.Value ' Jour de protection
sheets(«Visu install»).Range("O" & Ligne2) = Me.TextBox11.Value ' Heure MES/MHS
sheets(«Visu install»).Range("P" & Ligne2) = Me.TextBox12.Value ' Code client
sheets(«Visu install»).Range("Q" & Ligne2) = Me.TextBox13.Value ' Code accès
sheets(«Visu install»).Range("r" & Ligne2) = Me.TextBox17.Value ' cour ou rue
sheets(«Visu install»).Range("s" & Ligne2) = Me.TextBox14.Value ' Contact
sheets(«Visu install»).Range("t" & Ligne2) = Me.TextBox15.Value ' Téléphone
sheets(«Visu install»).Range("u" & Ligne2) = Me.TextBox18.Value ' Commercial


Ligne2 = Ligne2 +1


Unload Me

End If
End Sub

Suerte
Croco
 

virginie75015

XLDnaute Nouveau
Merci pour ta réponse.

par contre je souhaite seulement que les textbox suivantes soit recopier :

TextBox3 se recopie sur la feuil Visu install en A243
TextBox5 se recopie sur la feuil Visu install en B243
TextBox9 se recopie sur la feuil Visu install en C243

je ne doit pas nommer la feuille Visu instal aussi ici :
Private Sub UserForm_Initialize()
Set ws = Sheets("GESTION CHANTIER")
End Sub
 

croco40

XLDnaute Occasionnel
Dans ce cas tu supprime les autres.

@
je ne doit pas nommer la feuille Visu instal aussi ici :
Private Sub UserForm_Initialize()
Set ws = Sheets("GESTION CHANTIER")
End Sub

Je ne comprends pas, tu parles de la feuille visu instal et de la feuille "GESTION CHANTIER".

Tu veux que ça se copi sur quelle feuille ?

Suerte croco
 

virginie75015

XLDnaute Nouveau
En faite le code que j'ai mis dans mon 1er post, me permet de copier les elements d'un formulaire dans le tableau qui se trouve sur la feuille GESTION CHANTIER.

Ce que je souhaite, c'est simplement rajouter à ce code qui fonctionne tres bien les fonctions suivantes :

Recopier la TEXTBOX3, TEXTBOX5 et TEXTBOX9 sur une feuille qui s'appel Visu install.

La textbox3 doit se recopier dans A de la feuil Visu install
La textbox5 doit se recopier dans B de la feuil Visu install
La textbox9 doit se recopier dans C de la feuil Visu install.

Voici le code ci-dessous qui fonctionne tres bien pour la recopie dans GESTION CHANTIER.

Option Explicit

Dim ws As Worksheet, a()

Private Sub CommandButton1_Click()

Dim Ligne As Long

If Trim(Me.TextBox1) = "" Then
MsgBox "Numéro obligatoire"
ElseIf Not IsDate(Me.TextBox9) Then
MsgBox "Date non conforme"
Me.TextBox9 = ""
Me.TextBox9.SetFocus
Else
If ws.Range("A3") <> "" Then
Ligne = ws.Range("A2").End(xlDown).Row + 1
Else
Ligne = 3
End If
ws.Range("A" & Ligne) = Me.TextBox1.Value ' Numéro
ws.Range("B" & Ligne) = Me.TextBox2.Value ' Nom
ws.Range("C" & Ligne) = Me.TextBox3.Value ' Client
ws.Range("D" & Ligne) = Me.TextBox4.Value ' Code
ws.Range("E" & Ligne) = Me.TextBox5.Value ' Lieu
ws.Range("F" & Ligne) = Me.TextBox6.Value ' Code postal et Ville
ws.Range("G" & Ligne) = Me.TextBox7.Value ' Tarif
ws.Range("H" & Ligne) = Me.TextBox8.Value ' Nombre IR
ws.Range("I" & Ligne) = CDate(Me.TextBox9.Value) ' Date
ws.Range("N" & Ligne) = Me.TextBox10.Value ' Jour de protection
ws.Range("O" & Ligne) = Me.TextBox11.Value ' Heure MES/MHS
ws.Range("P" & Ligne) = Me.TextBox12.Value ' Code client
ws.Range("Q" & Ligne) = Me.TextBox13.Value ' Code accès
ws.Range("r" & Ligne) = Me.TextBox17.Value ' cour ou rue
ws.Range("s" & Ligne) = Me.TextBox14.Value ' Contact
ws.Range("t" & Ligne) = Me.TextBox15.Value ' Téléphone
ws.Range("u" & Ligne) = Me.TextBox18.Value ' Commercial
Unload Me

End If
End Sub

Private Sub UserForm_Initialize()
Set ws = Sheets("GESTION CHANTIER")
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir le fil, bonsoir le forum,

Essaie comme ça :

VB:
Option Explicit
Dim a()

Private Sub CommandButton1_Click()
Dim GC As Worksheet
Dim VI As Worksheet
Dim LGC As Long
Dim LVI As Long

Set GC = Sheets("GESTION CHANTIER")
Set VI = Worksheets("Visu install")
If Trim(Me.TextBox1) = "" Then
  Me.TextBox1.SetFocus
  MsgBox "Numéro obligatoire"
  Exit Sub
End If
If Not IsDate(Me.TextBox9) Then
  MsgBox "Date non conforme"
  Me.TextBox9 = ""
  Me.TextBox9.SetFocus
  Exit Sub
End If
LGC = IIf(GC.Range("A3") = "", 3, GC.Range("A2").End(xlDown).Row + 1)
LVI = IIf(VI.Range("A3") = "", 3, VI.Range("A2").End(xlDown).Row + 1)
GC.Range("A" & LGC) = Me.TextBox1.Value ' Numéro
GC.Range("B" & LGC) = Me.TextBox2.Value ' Nom
GC.Range("C" & LGC) = Me.TextBox3.Value ' Client
GC.Range("D" & LGC) = Me.TextBox4.Value ' Code
GC.Range("E" & LGC) = Me.TextBox5.Value ' Lieu
GC.Range("F" & LGC) = Me.TextBox6.Value ' Code postal et Ville
GC.Range("G" & LGC) = Me.TextBox7.Value ' Tarif
GC.Range("H" & LGC) = Me.TextBox8.Value ' Nombre IR
GC.Range("I" & LGC) = CDate(Me.TextBox9.Value) ' Date
GC.Range("N" & LGC) = Me.TextBox10.Value ' Jour de protection
GC.Range("O" & LGC) = Me.TextBox11.Value ' Heure MES/MHS
GC.Range("P" & LGC) = Me.TextBox12.Value ' Code client
GC.Range("Q" & LGC) = Me.TextBox13.Value ' Code accès
GC.Range("r" & LGC) = Me.TextBox17.Value ' cour ou rue
GC.Range("s" & LGC) = Me.TextBox14.Value ' Contact
GC.Range("t" & LGC) = Me.TextBox15.Value ' Téléphone
GC.Range("u" & LGC) = Me.TextBox18.Value ' Commercial
VI.Cells(LVI, "A").Value = Me.TextBox3.Value ' Client
VI.Cells(LVI, "B").Value = Me.TextBox5.Value ' Lieu
VI.Cells(LVI, "C").Value = Cdtse(Me.TextBox9.Value) ' Date
Unload Me
End Sub
 

virginie75015

XLDnaute Nouveau
Merci de ta reponse, c'est super cool,

Euhh ptite question, sachant que mon tableau sur la feuil Visu install la prochaine ligne vide est la 243 je doit donc modifier ceci :

LVI = IIf(VI.Range("A3") = "", 3, VI.Range("A2").End(xlDown).Row + 1)

comme ca

LVI = IIf(VI.Range("A243") = "", 3, VI.Range("A242").End(xlDown).Row + 1)
 

virginie75015

XLDnaute Nouveau
Bon bein j'ai tester ton code, et ca fonctionne nikel, j'ai juste corriger une petite erreur
VI.Cells(LVI, "C").Value = Cdtse(Me.TextBox9.Value) ' Date
que j'ai modifié par
VI.Cells(LVI, "C").Value = Cdate(Me.TextBox9.Value) ' Date

Sur mon code d'origine j'avais ceci ci-dessous je peux le supprimer maintenant?
Private Sub UserForm_Initialize()
Set ws = Sheets("GESTION CHANTIER")
End Sub
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 932
Messages
2 093 733
Membres
105 802
dernier inscrit
Witchun