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

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

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

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

E
  • Question Question
XL 2019 Extraction de données
Réponses
2
Affichages
283
efmls
E
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
245
NONO14
N
J
  • Résolu(e)
Microsoft 365 [RESOLU] VBA boucle, insertion plusieurs lignes, exécution formules, suppression sur si
Réponses
5
Affichages
456
Phil69970
Phil69970
S
  • Question Question
Microsoft 365 Liaison de données sur deux tableurs
Réponses
6
Affichages
313
JHA
J
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
717
Pac41240
P
Simbaa
  • Résolu(e)
Microsoft 365 Userform - Transfert de données
Réponses
6
Affichages
502
Simbaa
Simbaa
M
  • Question Question
Microsoft 365 Analyse de données, copie conditionnée
Réponses
7
Affichages
459
Max
M
Phil Du59
  • Résolu(e)
Microsoft 365 Tableau de STATS sur autre feuille
Réponses
8
Affichages
339
AtTheOne
AtTheOne
B
  • Question Question
Microsoft 365 compiler onglets excel avec VBA
Réponses
6
Affichages
620
Boubie
B
R
  • Question Question
XL 2021 Récupérer des données dans plusieurs classeurs sans les ouvrir - Résolu
Réponses
10
Affichages
489
job75
job75
D
  • Résolu(e)
Microsoft 365 Graphique avec plage de données glissante en partant d'une date
Réponses
5
Affichages
259
Dégé59
D
M
  • Résolu(e)
XL 2021 PUBLIPOSTAGE : Mise en forme du corps de message issu d'une cellule excel (VBA)
Réponses
4
Affichages
408
Minus&Cortex
M
A
  • Question Question
XL 2016 Mise en forme conditionnelle sur plusieurs lignes
Réponses
2
Affichages
559
Arnauddu44
A
C
  • Résolu(e)
XL 2016 VBA : inversion de Date sur Range.Resize ... = Tableau après Transpose du Tableau
Réponses
2
Affichages
184
crocrocro
C
Akortys
  • Question Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
8
Affichages
707
Akortys
Akortys
L
  • Résolu(e)
XL 2016 MFC sur plusieurs critères
2 3 4
Réponses
55
Affichages
2 K
Lorenzini
L
M
  • Question Question
Microsoft 365 Comptabilité : Création d'un fichier automatique d'analyse de comptes
Réponses
2
Affichages
522
Max
M
G
  • Question Question
Microsoft 365 Import Donnes issu de fichier CSV
2 3
Réponses
40
Affichages
2 K
laurent950
laurent950
B
  • Question Question
XL 2016 Exécution macro à l'ouverture de fichier
Réponses
3
Affichages
606
crocrocro
C
H
  • Question Question
XL 2021 importer automatiquement des données à partir d'un tableau en fonction du jour du mois
Réponses
2
Affichages
606
Hamid84
H

Membres actuellement en ligne

22 membres et 241 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
315 297
Messages
2 118 164
Membres
113 441
dernier inscrit
elddr40