Discussion :

[vinvinsylvain]

Formulaire

Bonjour, j'ai encore besoin de votre aide, je ne comprend ou se trouve mon erreur.

Voilà on remplis le formulaire, puis quand on clique sur valide, ceci doit recopier les données dans "DONNEES", mais malheureusement ceci écrasse les données déja dans "Données".
Quelqu'un aurai une idée.

Merci à vous

Code vba :

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
35
36
37
38
39
40
41
42
43
Private Sub CommandButton3_Click()
On Error Resume Next
'Valider la recherche et l'incorporer dans la basse de données
 
If MsgBox("Confirmez vous l'enregistrement de la saisie ?", 36, "Confirmation") = vbYes Then
'valider la saisie
  Sheets("DONNEES").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "8"
    Range("A3").Select
    Sheets("FORMULAIRE").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    Range("L4:AN4").Select
    Selection.Copy
    Sheets("DONNEES").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("FORMULAIRE").Select
end sub

[ARTURO83]

Bonjour,

Pourquoi inscrivez-vous "8" dans A2 de "Données" pour l'écraser par la suite avec les valeurs de L4 de"Formulaire"?
Sinon le code

Code :

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

1
2
3
4
5
6
7
8
Private Sub CommandButton3_Click()
    If MsgBox("Confirmez vous l'enregistrement de la saisie ?", 36, "Confirmation") = vbNo Then Exit Sub
    'valider la saisie
    Sheets("DONNEES").Select
    Rows("2:2").Insert Shift:=xlDown
    Sheets("FORMULAIRE").Range("L4:AN4").Copy Range("A2")
    Sheets("FORMULAIRE").Select
End Sub

Cdlt

[vinvinsylvain]

[QUOTE=ARTURO83;11599046]Bonjour,

Pourquoi inscrivez-vous "8" dans A2 de "Données" pour l'écraser par la suite avec les valeurs de L4 de"Formulaire"?
Sinon le code

Je ne sais pas pourquoi il y a la ligne de code pour "8" erreur de saisie.
Par contre le code que tu m'a transmis ne fonctionne pas il me décale tout dans "Formulaire"

Je ne peux envoyer le fichier, il est trop lourd

[ARTURO83]

Par contre le code que tu m'a transmis ne fonctionne pas il me décale tout dans "Formulaire"

je n'ai fait que retranscrire votre code, on insère un ligne a partir de la 2ème, donc on décale l'ensemble des données existantes vers le bas et on colle en A2 et colonnes suivantes les valeurs de L4:AN4. Ce n'est pas ça?

[vinvinsylvain]

Voilà ce que j'aimerai:

valeur ==> recopier à en insérant une ligne
FEUILLE "FORMULAIRE" B34 ==> FEUILLE "DONNES" A2
FEUILLE "FORMULAIRE" B33 ==> FEUILLE "DONNES" B2
FEUILLE "FORMULAIRE" B13 ==> FEUILLE "DONNES" C2
FEUILLE "FORMULAIRE" B14 ==> FEUILLE "DONNES" D2
FEUILLE "FORMULAIRE" B15 ==> FEUILLE "DONNES" E2
FEUILLE "FORMULAIRE" B17 ==> FEUILLE "DONNES" F2
FEUILLE "FORMULAIRE" B18 ==> FEUILLE "DONNES" G2
FEUILLE "FORMULAIRE" B19 ==> FEUILLE "DONNES" H2
FEUILLE "FORMULAIRE" B21 ==> FEUILLE "DONNES" I2
FEUILLE "FORMULAIRE" B22 ==> FEUILLE "DONNES" J2
FEUILLE "FORMULAIRE" B23 ==> FEUILLE "DONNES" K2
FEUILLE "FORMULAIRE" B24 ==> FEUILLE "DONNES" L2
FEUILLE "FORMULAIRE" B25 ==> FEUILLE "DONNES" M2
FEUILLE "FORMULAIRE" B27 ==> FEUILLE "DONNES" N2
FEUILLE "FORMULAIRE" B28 ==> FEUILLE "DONNES" O2
FEUILLE "FORMULAIRE" B29 ==> FEUILLE "DONNES" P2
FEUILLE "FORMULAIRE" F14 ==> FEUILLE "DONNES" Q2
FEUILLE "FORMULAIRE" F15 ==> FEUILLE "DONNES" R2
FEUILLE "FORMULAIRE" F17 ==> FEUILLE "DONNES" S2
FEUILLE "FORMULAIRE" F18 ==> FEUILLE "DONNES" T2
FEUILLE "FORMULAIRE" F19 ==> FEUILLE "DONNES" U2
FEUILLE "FORMULAIRE" F20 ==> FEUILLE "DONNES" V2
FEUILLE "FORMULAIRE" F24 ==> FEUILLE "DONNES" W2
FEUILLE "FORMULAIRE" F25 ==> FEUILLE "DONNES" X2
FEUILLE "FORMULAIRE" F26 ==> FEUILLE "DONNES" Y2
FEUILLE "FORMULAIRE" F28 ==> FEUILLE "DONNES" Z2
FEUILLE "FORMULAIRE" F29 ==> FEUILLE "DONNES" AA2
FEUILLE "FORMULAIRE" F30 ==> FEUILLE "DONNES" AB2

[ARTURO83]

Alors ceci

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
Private Sub CommandButton3_Click()
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    If MsgBox("Confirmez vous l'enregistrement de la saisie ?", 36, "Confirmation") = vbNo Then Exit Sub
    'valider la saisie
    Set f1 = Sheets("FORMULAIRE")
    Set f2 = Sheets("DONNEES")
    f2.Select
    Rows("2:2").Insert Shift:=xlDown
    f2.Range("A2") = f1.Range("B34")
    f2.Range("B2") = f1.Range("B33")
    f1.Range("B13:B15").Copy
    f2.Range("C2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("B17:B19").Copy
    f2.Range("F2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("B21:B25").Copy
    f2.Range("I2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("B27:B29").Copy
    f2.Range("N2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F14:F15").Copy
    f2.Range("Q2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F17:F20").Copy
    f2.Range("S2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F24:F26").Copy
    f2.Range("W2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F28:F30").Copy
    f2.Range("Z2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

[vinvinsylvain]

Ce que je ne comprend pas, j'avais le même soucis avec mon code, il insert une ligne dans FORMULAIRE alors que je veux donnée

Je vous joint mon fichier j'ai supprimer des pages pour qu'il soit moins lourd
Formulaire de renseignement TEST.xlsx

[ARTURO83]

Parce que le code est dans le module de la feuille "Formulaire", il faut dans ce cas déplacer le code dans une sub classique et l'appeler depuis la sub " CommandButton3_Click()", ce qui donne

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
35
Sub CommandButton3_Click()
    Valider
End Sub
 
Sub Valider()
    Dim f1 As Worksheet, f2 As Worksheet
    Application.ScreenUpdating = False
    If MsgBox("Confirmez vous l'enregistrement de la saisie ?", 36, "Confirmation") = vbNo Then Exit Sub
    'valider la saisie
    Set f1 = Sheets("FORMULAIRE")
    Set f2 = Sheets("DONNEES")
    f2.Select
    f2.Rows("2:2").Insert Shift:=xlDown
    f2.Range("A2") = f1.Range("B34")
    f2.Range("B2") = f1.Range("B33")
    f1.Range("B13:B15").Copy
    f2.Range("C2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("B17:B19").Copy
    f2.Range("F2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("B21:B25").Copy
    f2.Range("I2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("B27:B29").Copy
    f2.Range("N2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F14:F15").Copy
    f2.Range("Q2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F17:F20").Copy
    f2.Range("S2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F24:F26").Copy
    f2.Range("W2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Range("F28:F30").Copy
    f2.Range("Z2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    f1.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

[vinvinsylvain]

Grand merci a ARTURO83 c'est exactement ce que je voulais