Macros transférer valeur d'une feuille à une autre

Version imprimable

10/05/2019, 09h24
anis.abbadi

Macros transférer valeur d'une feuille à une autre

Bonjour,

Je débute dans les macros et j'ai un projet à terminer. Dans celui- là je dois transférer des valeurs contenue dans un tableau dans une feuille nommé "Feuil2" vers un tableau dans une feuille nommé "Feuil3". Cette "Feuil3" est une synthèse de toute les feuilles "Feuil2" existantes. C'est pourquoi le bouton dans la feuille "Feuil2" doit vérifier si la ligne du tableau est vide, si elle l'est il enregistre des valeurs sur plusieurs colonnes ou passe à la ligne suivantes. Ces valeurs seront enregistrez dans la feuille "Feuil3" comme dit précédemment.

Je consultez plusieurs forum mais aucun n'a su satisfaire ma requêtes.

Merci d'éclairez ma lanterne.

bonjour anis , la forum
La demande n'est pas très claire au moins pour moi
mais si dans la feuil2 qui serve comme feuille de saisie et puis transférer les données vers la feuil3 dans la première ligne vide
essayez avec
Code:

1 2 3 4 5 6 7 8 9 Sub testt() Application.ScreenUpdating = False With Sheets("feuil2") .Activate .Range("A2:D2").Copy Destination:=Worksheets("feuil3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End With Sheets("feuil3").Select Application.ScreenUpdating = True End Sub

10/05/2019, 09h39
BENNASR

1 pièce(s) jointe(s)

voila un exemple en espérant que ça t'aide à avancer

Citation:

Envoyé par BENNASR

bonjour anis , la forum
La demande n'est pas très claire au moins pour moi
mais si dans la feuil2 qui serve comme feuille de saisie et puis transférer les données vers la feuil3 dans la première ligne vide
essayez avec

Merci ton code est clair mais je dois copié les cellules de la "feuil2" de la colonne E24:V24 et les recopier à partir de la ligne E8:V8 dans la "feuil3"
Code:

1 2 3 4 5 6 7 8 9 Sub enreg_intervenant() Application.ScreenUpdating = False With Sheets("feuil2") .Activate .Range("E24:V24").Copy Destination:=Worksheets("feuil3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End With Sheets("feuil3").Select Application.ScreenUpdating = True End Sub
Ceci fera l'affaire ?

10/05/2019, 10h35
BENNASR

merci d'envoyer un fichier exemple sans données confidentielles
10/05/2019, 10h35
anis.abbadi

Je viens de tester ce code et ceci me les colle de la colonne A2 à R2, et génère une erreur "#REF "
10/05/2019, 10h43
anis.abbadi

Citation:

Envoyé par BENNASR

merci d'envoyer un fichier exemple sans données confidentielles

https://www.transfernow.net/10e9d3113zgp
Je n'arrive pas à joindre le fichier, je l'ai donc upload.
Merci à toi
10/05/2019, 10h46
anis.abbadi

1 pièce(s) jointe(s)

Ou autre moyen de le dl

à tester et dire les remarques

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub enreg_intervenant()
Application.ScreenUpdating = False
Dim derlig As Long
derlig = Sheets("feuil3").Range("A" & Rows.Count).End(xlUp).Row + 7
With Sheets("feuil2")
.Activate
.Range("E24:V24").Copy
Sheets("feuil3").Range("E" & derlig).PasteSpecial Paste:=xlPasteValues
End With
Sheets("feuil3").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Citation:
Envoyé par BENNASR
à tester et dire les remarques
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub enreg_intervenant() Application.ScreenUpdating = False Dim derlig As Long derlig = Sheets("feuil3").Range("A" & Rows.Count).End(xlUp).Row + 7 With Sheets("feuil2") .Activate .Range("E24:V24").Copy Sheets("feuil3").Range("E" & derlig).PasteSpecial Paste:=xlPasteValues End With Sheets("feuil3").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
Les valeurs sont bien enregistrer mais lorsque je re-clique sur le bouton ceci ne passe pas à la ligne suivante ? Est-ce possible de modifier le code pour arriver à cela ?

c'est du bricolage à tester

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
Sub enreg_intervenant()
Application.ScreenUpdating = False
Dim j As Integer
With Sheets("feuil3")
If .Cells(8, 5) = "" And .Cells(9, 5) = "" Then j = 8
If .Cells(8, 5) <> "" And .Cells(9, 5) = "" And .Cells(10, 5) = "" Then j = 9
If .Cells(9, 5) <> "" And .Cells(10, 5) = "" And .Cells(11, 5) = "" Then j = 10
If .Cells(10, 5) <> "" And .Cells(11, 5) = "" And .Cells(12, 5) = "" Then j = 11
If .Cells(11, 5) <> "" And .Cells(12, 5) = "" And .Cells(13, 5) = "" Then j = 12
If .Cells(12, 5) <> "" And .Cells(13, 5) = "" And .Cells(14, 5) = "" Then j = 13
If .Cells(13, 5) <> "" And .Cells(14, 5) = "" And .Cells(15, 5) = "" Then j = 14
If .Cells(14, 5) <> "" And .Cells(15, 5) = "" And .Cells(16, 5) = "" Then j = 15
If .Cells(15, 5) <> "" And .Cells(16, 5) = "" And .Cells(17, 5) = "" Then j = 16
If .Cells(16, 5) <> "" And .Cells(17, 5) = "" And .Cells(18, 5) = "" Then j = 17
If .Cells(17, 5) <> "" And .Cells(18, 5) = "" And .Cells(19, 5) = "" Then j = 18
If .Cells(18, 5) <> "" And .Cells(18, 5) <> "" And .Cells(19, 5) = "" Then j = 19
End With
 
 
With Sheets("feuil2")
.Activate
.Range("E24:V24").Copy
Sheets("feuil3").Range("E" & j).PasteSpecial Paste:=xlPasteValues
End With
Sheets("feuil3").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub