XL 2013 VBA - inscription de données sur plusieurs lignes

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Roseline

Roseline

XLDnaute Occasionnel
Bonjour,
J'ai besoin de votre aide. Vous trouvez mon fichier joint.
J'ai un onglet #1 dans lequel les données seront inscrites. Mes données se transfère dans mon onglet Feuil1 et se positionne au bon endroit. Ce que j'aimerais c'est que si un chiffre est indiqué dans une des cases en rouge, lors de l'envoi des données sur la Feuil1, toutes les autres informations se répètent en avant du numéro. C'est peut-être avec la fonction LOOP mais je ne sais pas du tout comment l'adapter.
Merci de m'aider.
 

Pièces jointes

Trier par date Trier par votes
Bonsoir Roseline,
Le mot de passe VBA n'était pas utile, et bien sûr superflu. 🙂
En PJ un essai avec :
VB: 
Sub Transfert()
Application.ScreenUpdating = False
With Sheets("1")
   If .Range("C8") <> "" Then Stocke .Range("C8")
   If .Range("C9") <> "" Then Stocke .Range("C9")
   If .Range("D8") <> "" Then Stocke .Range("D8")
   If .Range("D9") <> "" Then Stocke .Range("D9")
End With
End Sub
Sub Stocke(Valeur)
DL = 1 + Sheets("Feuil2").Range("A65500").End(xlUp).Row
With Sheets("Feuil2")
    .Cells(DL, "A") = Sheets("1").[B3]
    .Cells(DL, "B") = Sheets("1").[D3]
    .Cells(DL, "C") = Sheets("1").[C7]
    .Cells(DL, "D") = Valeur
End With
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
sylvanu à dit:
Bonsoir Roseline,
Le mot de passe VBA n'était pas utile, et bien sûr superflu. 🙂
En PJ un essai avec :
VB: 
Sub Transfert()
Application.ScreenUpdating = False
With Sheets("1")
   If .Range("C8") <> "" Then Stocke .Range("C8")
   If .Range("C9") <> "" Then Stocke .Range("C9")
   If .Range("D8") <> "" Then Stocke .Range("D8")
   If .Range("D9") <> "" Then Stocke .Range("D9")
End With
End Sub
Sub Stocke(Valeur)
DL = 1 + Sheets("Feuil2").Range("A65500").End(xlUp).Row
With Sheets("Feuil2")
    .Cells(DL, "A") = Sheets("1").[B3]
    .Cells(DL, "B") = Sheets("1").[D3]
    .Cells(DL, "C") = Sheets("1").[C7]
    .Cells(DL, "D") = Valeur
End With
End Sub
Cliquez pour agrandir...
C'est exactement ce que je voulais, merci énormément de votre aide.
Je vous souhaite une excellente journée 🙂
 
Vote positif 0 Vote négatif
sylvanu à dit:
Bonsoir Roseline,
Le mot de passe VBA n'était pas utile, et bien sûr superflu. 🙂
En PJ un essai avec :
VB: 
Sub Transfert()
Application.ScreenUpdating = False
With Sheets("1")
   If .Range("C8") <> "" Then Stocke .Range("C8")
   If .Range("C9") <> "" Then Stocke .Range("C9")
   If .Range("D8") <> "" Then Stocke .Range("D8")
   If .Range("D9") <> "" Then Stocke .Range("D9")
End With
End Sub
Sub Stocke(Valeur)
DL = 1 + Sheets("Feuil2").Range("A65500").End(xlUp).Row
With Sheets("Feuil2")
    .Cells(DL, "A") = Sheets("1").[B3]
    .Cells(DL, "B") = Sheets("1").[D3]
    .Cells(DL, "C") = Sheets("1").[C7]
    .Cells(DL, "D") = Valeur
End With
End Sub
Cliquez pour agrandir...
Allo,
Tout fonctionne parfaitement mais j'ai une interrogation. Je désire envoyer les informations dans un autre fichier mais je suis incapable de modifier la commande. Peux-tu m'aider svp
 
Vote positif 0 Vote négatif
Bonsoir Roseline,
Il faut que le second fichier soit ouvert, dans ce cas testez :
VB: 
Sub Essai()
DL = 5
With Workbooks("Bob2.xlsx").Sheets("Feuil2")
    .Cells(DL, "A") = Sheets("Feuil2").[B3]
    .Cells(DL, "B") = Sheets("Feuil2").[D3]
    .Cells(DL, "C") = Sheets("Feuil2").[C7]
End With
End Sub
Dans cet exemple le second fichier s'appelle Bob2.xlsx.
 
Vote positif 0 Vote négatif
sylvanu à dit:
Bonsoir Roseline,
Il faut que le second fichier soit ouvert, dans ce cas testez :
VB: 
Sub Essai()
DL = 5
With Workbooks("Bob2.xlsx").Sheets("Feuil2")
    .Cells(DL, "A") = Sheets("Feuil2").[B3]
    .Cells(DL, "B") = Sheets("Feuil2").[D3]
    .Cells(DL, "C") = Sheets("Feuil2").[C7]
End With
End Sub
Dans cet exemple le second fichier s'appelle Bob2.xlsx.
Cliquez pour agrandir...
Ca ne fonctionne pas, il ne copie rien du tout dans le nouveau fichier. Je ne comprend pas, pouvez-vous m'éclairer svp?
Merci
 
Vote positif 0 Vote négatif
Bonjour Roseline,
Cette ligne ne peut pas marcher, la feuille source s'appelle "1"
Code: 
.Cells(DL, "A") = Sheets("Feuil2").[B3]
mais
.Cells(DL, "A") = Sheets("1").[B3]
Donc :
VB: 
Sub Essai()
' Pour essai
    Sheets("1").[C8] = Sheets("1").[C8] + 1
    Sheets("1").[C9] = Sheets("1").[C9] + 1
    Sheets("1").[D8] = Sheets("1").[D8] + 1
    Sheets("1").[D9] = Sheets("1").[D9] + 1
    
' Transfert
With Workbooks("ClasseurV2.xlsx").Sheets("Feuil2")
    DL = .Range("A65500").End(xlUp).Row + 1
    .Cells(DL, "A") = Sheets("1").[C8]
    .Cells(DL, "B") = Sheets("1").[C9]
    .Cells(DL, "C") = Sheets("1").[D8]
    .Cells(DL, "D") = Sheets("1").[D9]
End With
End Sub
Voir PJ.
 

Pièces jointes

Vote positif 0 Vote négatif
sylvanu à dit:
Bonjour Roseline,
Cette ligne ne peut pas marcher, la feuille source s'appelle "1"
Code: 
.Cells(DL, "A") = Sheets("Feuil2").[B3]
mais
.Cells(DL, "A") = Sheets("1").[B3]
Donc :
VB: 
Sub Essai()
' Pour essai
    Sheets("1").[C8] = Sheets("1").[C8] + 1
    Sheets("1").[C9] = Sheets("1").[C9] + 1
    Sheets("1").[D8] = Sheets("1").[D8] + 1
    Sheets("1").[D9] = Sheets("1").[D9] + 1
   
' Transfert
With Workbooks("ClasseurV2.xlsx").Sheets("Feuil2")
    DL = .Range("A65500").End(xlUp).Row + 1
    .Cells(DL, "A") = Sheets("1").[C8]
    .Cells(DL, "B") = Sheets("1").[C9]
    .Cells(DL, "C") = Sheets("1").[D8]
    .Cells(DL, "D") = Sheets("1").[D9]
End With
End Sub
Voir PJ.
Cliquez pour agrandir...
Oui ca fonctionne sauf que je veux que ma cellule B3, D3 et C6 et C7 se recopie tout le temps selon le nombre de données entrée dans les cases en rouges mais sur des lignes différentes
Ex: Initiation - Date - Solde - Réduit - 4
Initiation - Date - Solde - Réduit -11
et ainsi de suis tant que j'ai des données d'inscrite dans les cellules c8 à D9
Merci encore de ton aide si précieuse
 
Vote positif 0 Vote négatif
C'était un exemple. Le problème était le transfert dans un autre fichier. C'est tout.
Pour résoudre votre problème initial reprenez la macro initiale, modifiée avec le nouveau transfert :
VB: 
Sub Transfert()
Application.ScreenUpdating = False
With Sheets("1")
   If .Range("C8") <> "" Then Stocke .Range("C8")
   If .Range("C9") <> "" Then Stocke .Range("C9")
   If .Range("D8") <> "" Then Stocke .Range("D8")
   If .Range("D9") <> "" Then Stocke .Range("D9")
End With
End Sub
Sub Stocke(Valeur)
With Workbooks("ClasseurV2.xlsx").Sheets("Feuil2")
    DL = .Range("A65500").End(xlUp).Row + 1
    .Cells(DL, "A") = Sheets("1").[B3]
    .Cells(DL, "B") = Sheets("1").[D3]
    .Cells(DL, "C") = Sheets("1").[C7]
    .Cells(DL, "D") = Valeur
End With
End Sub
 
Vote positif 0 Vote négatif
sylvanu à dit:
C'était un exemple. Le problème était le transfert dans un autre fichier. C'est tout.
Pour résoudre votre problème initial reprenez la macro initiale, modifiée avec le nouveau transfert :
VB: 
Sub Transfert()
Application.ScreenUpdating = False
With Sheets("1")
   If .Range("C8") <> "" Then Stocke .Range("C8")
   If .Range("C9") <> "" Then Stocke .Range("C9")
   If .Range("D8") <> "" Then Stocke .Range("D8")
   If .Range("D9") <> "" Then Stocke .Range("D9")
End With
End Sub
Sub Stocke(Valeur)
With Workbooks("ClasseurV2.xlsx").Sheets("Feuil2")
    DL = .Range("A65500").End(xlUp).Row + 1
    .Cells(DL, "A") = Sheets("1").[B3]
    .Cells(DL, "B") = Sheets("1").[D3]
    .Cells(DL, "C") = Sheets("1").[C7]
    .Cells(DL, "D") = Valeur
End With
End Sub
Cliquez pour agrandir...
Ca fonctionne merveilleusement bien. Je vous remercie vous m'avez sauvé énormément de temps.
Bonne journée 🙂
 
Vote positif 0 Vote négatif
sylvanu à dit:
C'était un exemple. Le problème était le transfert dans un autre fichier. C'est tout.
Pour résoudre votre problème initial reprenez la macro initiale, modifiée avec le nouveau transfert :
VB: 
Sub Transfert()
Application.ScreenUpdating = False
With Sheets("1")
   If .Range("C8") <> "" Then Stocke .Range("C8")
   If .Range("C9") <> "" Then Stocke .Range("C9")
   If .Range("D8") <> "" Then Stocke .Range("D8")
   If .Range("D9") <> "" Then Stocke .Range("D9")
End With
End Sub
Sub Stocke(Valeur)
With Workbooks("ClasseurV2.xlsx").Sheets("Feuil2")
    DL = .Range("A65500").End(xlUp).Row + 1
    .Cells(DL, "A") = Sheets("1").[B3]
    .Cells(DL, "B") = Sheets("1").[D3]
    .Cells(DL, "C") = Sheets("1").[C7]
    .Cells(DL, "D") = Valeur
End With
End Sub
Cliquez pour agrandir...
Rebonjour,
Voilà qu'il m'apparait un nouveau problème. Ma programmation fonctionne très bien jusqu'à ce que je lui demande d'ouvrir le fichier dans un répertoire et d'aller y déposer les données. As-tu une idée de la raison. la VBA ouvre bien le fichier et trouve la dernière ligne mais bloque à cet emplacement : .Cells(DL, "A") = Sheets("1").[B3]
 
Vote positif 0 Vote négatif
Bonjour Roseline,
Dans :
VB: 
With Workbooks("ClasseurV2.xlsx").Sheets("Feuil2")
DL = .Range("A65500").End(xlUp).Row + 1
Avez vous bien le bon nom de fichier et le nom nom de feuille ?
Et DL est il pertinent ? ( non nul et pas en erreur )
 
Vote positif 0 Vote négatif
Voilà une partie de mon code…..Je sais pas si avec cela tu vas pouvoir m'aider, sinon je peux retourner les fichiers?

Set wkbook1 = Workbooks.Open("U:\…..\….")
If wkbook1.ReadOnly Then
wkbook1.Close True
MsgBox ("Données non enregistrées, réessayer dans quelques minutes svp!")
Application.CutCopyModemode = False
Exit Sub

Else
Call Transfert
Call Stocke(Valeur)

Sub Transfert()
Application.ScreenUpdating = False
With Workbooks("xxxx").Sheets("xxx")
If .Range("C8") <> "" Then Stocke .Range("C8")
If .Range("C9") <> "" Then Stocke .Range("C9")
If .Range("D8") <> "" Then Stocke .Range("D8")
If .Range("D9") <> "" Then Stocke .Range("D9")
End With
End Sub


Sub Stocke(Valeur)
With Workbooks("xxx").Sheets("x")
DL = .Range("A65500").End(xlUp).Row + 1

.Cells(DL, "A") = Sheets("x").[B3]
.Cells(DL, "B") = Sheets("x").[D3]
.Cells(DL, "C") = Sheets("x").[C6]
.Cells(DL, "D") = Valeur
End With
End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

E
  • Question Question
Microsoft 365 Analyse de données temps de prod
Réponses
4
Affichages
201
ejik85
E
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
410
xavieralvaro
X
S
  • Question Question
Microsoft 365 Transfert de données sur une autre tableau
Réponses
2
Affichages
243
stefane26
S
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
1 K
Pac41240
P
M
  • Question Question
Microsoft 365 Analyse de données, copie conditionnée
Réponses
7
Affichages
739
Max
M
Simbaa
  • Résolu(e)
Microsoft 365 Userform - Transfert de données
Réponses
6
Affichages
602
Simbaa
Simbaa
M
  • Question Question
Microsoft 365 Comptabilité : Création d'un fichier automatique d'analyse de comptes
Réponses
2
Affichages
787
Max
M
jeff1494
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
755
jeff1494
jeff1494
V
  • Question Question
Microsoft 365 Resume de plusieurs fichier
Réponses
2
Affichages
396
Cousinhub
Cousinhub
R
  • Résolu(e)
Autres Masquer des lignes et colonnes en fonction d'une valeur d'un menu déroulant
Réponses
1
Affichages
575
Romain77144
R
A
  • Question Question
XL pour MAC Peut on mettre plusieurs données de différentes lignes sur une seule ?
Réponses
5
Affichages
1 K
chris
chris
G
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
805
GClaire
G
B
  • Question Question
XL 2016 VBA formulaire incrémenter un N° de facture selon l'année(mais dates sur deux colonnes)
Réponses
4
Affichages
705
badduke
B
A
  • Question Question
Microsoft 365 Fichier de statistique et roulement
Réponses
0
Affichages
539
Aurel’Byylieve
A
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
Dranreb
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
562
JJ69
J
Simbaa
  • Question Question
Microsoft 365 Création d'un fichier entier par rapport à des entrées via UserForm
Réponses
1
Affichages
701
job75
job75
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
1 K
Vermithor
V
B
  • Question Question
XL 2016 Comment figer une formule dans une nouvelle ligne insérée.
Réponses
1
Affichages
435
Lolote83
L
A
  • Résolu(e)
XL 2019 Créer une base de données à partir de plusieurs fichiers excel source
Réponses
7
Affichages
1 K
adrien786
A
Retour