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

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

  • test excel.xlsm
    29.8 KB · Affichages: 37
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • Classeur1.xlsm
    43.3 KB · Affichages: 6
Vote positif 0 Vote négatif
Roseline

Roseline

XLDnaute Occasionnel
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
Roseline

Roseline

XLDnaute Occasionnel
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
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
Roseline

Roseline

XLDnaute Occasionnel
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
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • Test Classeur.xlsm
    42.4 KB · Affichages: 3
  • ClasseurV2.xlsx
    30.5 KB · Affichages: 2
Vote positif 0 Vote négatif
Roseline

Roseline

XLDnaute Occasionnel
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
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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
Roseline

Roseline

XLDnaute Occasionnel
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
Roseline

Roseline

XLDnaute Occasionnel
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
Roseline

Roseline

XLDnaute Occasionnel
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

Discussions similaires

Simbaa
  • Résolu(e)
Microsoft 365 Userform - Transfert de données
Réponses
6
Affichages
343
Simbaa
Simbaa
B
  • Question
Microsoft 365 compiler onglets excel avec VBA
Réponses
6
Affichages
375
Boubie
B
A
  • Question
XL 2016 Mise en forme conditionnelle sur plusieurs lignes
Réponses
2
Affichages
342
Arnauddu44
A
Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
318
Akortys
Akortys
G
  • Question
Microsoft 365 Import Donnes issu de fichier CSV
2 3
Réponses
40
Affichages
1 K
laurent950
laurent950
B
  • Question
XL 2016 Exécution macro à l'ouverture de fichier
Réponses
3
Affichages
386
crocrocro
C
H
  • Question
XL 2021 importer automatiquement des données à partir d'un tableau en fonction du jour du mois
Réponses
2
Affichages
450
Hamid84
H
A
  • Résolu(e)
Microsoft 365 Copier la même cellule de plusieurs onglets dans différentes colonnes
2
Réponses
23
Affichages
1 K
AlexiaC
A
R
  • Résolu(e)
Autres Masquer des lignes et colonnes en fonction d'une valeur d'un menu déroulant
Réponses
1
Affichages
195
Romain77144
R
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
956
Dranreb
Dranreb

Membres actuellement en ligne

16 membres et 107 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 841
Messages
2 092 709
Membres
105 515
dernier inscrit
zourino