Modif macro qui copie d'un userform

Bernard-Louis

XLDnaute Occasionnel
Bonjour le forum,
J'ai cette formule qui copie les données d'un USF dans une feuille "Source". Cette formule me copie les lignes les une sous les autres.
Le probleme est que si une cellule au dessus est vide, les nouvelles données ne s'inscrivent pas sur la meme ligne, mais completent les cellules vides au dessus.
Que faut il faire pour que les données soient sur la meme ligne ?

'Copie des valeurs du formulaire vers l'onglet "Source"
Sheets("Source").Range("A65536").End(xlUp).Offset(1, 0).Value = Annee
Sheets("Source").Range("B65536").End(xlUp).Offset(1, 0).Value = Mois
Sheets("Source").Range("C65536").End(xlUp).Offset(1, 0).Value = Service

Merci pour l'aide .
 

Cousinhub

XLDnaute Barbatruc
Re : Modif macro qui copie d'un userform

Bonjour,
modifie comme ceci :

Code:
Sub essai()
Dim DerLig&
With Sheets("Source")
    DerLig = .[A65536].End(xlUp).Row + 1
    .Cells(DerLig, 1) = Annee
    .Cells(DerLig, 2) = Mois
    .Cells(DerLig, 3) = service
End With
End Sub

Edit : Salut pierrejean
 
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : Modif macro qui copie d'un userform

bonjour Bernard-Louis

teste:

Code:
Sheets("Source").Range("A65536").End(xlUp).Offset( 1, 0).Value = Annee
Sheets("Source").Range("A65536").End(xlUp).Offset( 1, 1).Value = Mois
Sheets("Source").Range("A65536").End(xlUp).Offset( 1, 2).Value = Service

explication:
c'est toujours la fin de colonne A qui sert de reference et on decale les colonnes par l'offset

[/code]

edit :

Salut bhbh :)
 

Bernard-Louis

XLDnaute Occasionnel
Re : Modif macro qui copie d'un userform

Bonjour Pierrejean,

Pour la premiere solution,
si la 1ere ligne est remplie, les donnees ne se recopient pas
Pour la seconde solution
Le probleme se pose juste pour la premiere colonne, car si la cellule "année" est vide au dessus, elle complete cette cellule.

Voici tout le code et merci encore pour le coup de main

Private Sub cmdValider_Click()
If Me.Annee.Text = "" Then
MsgBox "Vous devez entrer une année."
Me.Annee.SetFocus
Exit Sub
End If
If Me.Mois.Text = "" Then
MsgBox "Vous devez entrer un mois."
Me.Mois.SetFocus
Exit Sub
End If
If Me.Service.Text = "" Then
MsgBox "Vous devez entrer un service."
Me.Service.SetFocus
Exit Sub
End If
If Me.Nom_prenom.Text = "" Then
MsgBox "Vous devez entrer un nom et un prénom."
Me.Nom_prenom.SetFocus
Exit Sub
End If
If Me.delai.Text = "" Then
MsgBox "Vous devez entrer un nom."
Me.delai.SetFocus
Exit Sub
End If
If Me.Lieu.Text = "" Then
MsgBox "Vous devez entrer un lieu."
Me.Lieu.SetFocus
Exit Sub
End If
If Me.Projet.Text = "" Then
MsgBox "Vous devez entrer un projet."
Me.Projet.SetFocus
Exit Sub
End If
If Me.Nature_tache.Text = "" Then
MsgBox "Vous devez entrer une nature de tâche."
Me.Nature_tache.SetFocus
Exit Sub
End If
If Me.Entite_facturer.Text = "" Then
MsgBox "Vous devez entrer une entité à facturer."
Me.Entite_facturer.SetFocus
Exit Sub
End If
If Me.Duree_jours.Text = "" Then
MsgBox "Vous devez entrer un nombre de jours."
Me.Duree_jours.SetFocus
Exit Sub
End If

Dim derlig&

With Sheets("Source")
derlig = [A65536].End(xlUp) + 1

.Cells(derlig, 1) = Annee
.Cells(derlig, 2) = Mois
.Cells(derlig, 3) = Service
.Cells(derlig, 4) = Nom_prenom
.Cells(derlig, 5) = delai
.Cells(derlig, 6) = Lieu
.Cells(derlig, 7) = Projet
.Cells(derlig, 8) = Nature_tache
.Cells(derlig, 9) = Entite_facturer
.Cells(derlig, 10) = Duree_jours
.Cells(derlig, 11) = Transports
.Cells(derlig, 11) = Transports
.Cells(derlig, 12) = Logistique
.Cells(derlig, 13) = Divers
.Cells(derlig, 16) = Montant - frais


End With
'Copie des valeurs du formulaire vers l'onglet "Source"
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 0).Value = Annee
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 1).Value = Mois
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 2).Value = Service

'Cette ligne en plus de copier, met la 1ere lettre de chaque mot en majuscule
'par Application.Proper(Me!Nom_prenom)
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 3).Value = Application.Proper(Me!Nom_prenom)

'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 4).Value = delai
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 5).Value = Lieu
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 6).Value = Projet
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 7).Value = Nature_tache
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 8).Value = Entite_facturer
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 9).Value = Duree_jours
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 10).Value = Transports
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 11).Value = Logistique
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 12).Value = Divers
'Sheets("Source").Range("A65536").End(xlUp).Offset(1, 15).Value = Montant_Frais

Unload Me

End Sub
 

pierrejean

XLDnaute Barbatruc
Re : Modif macro qui copie d'un userform

Re

Effectivement ma solution etait boiteuse !!
Apres la premiere copie de donnée le End(xlup) est recalculé par consequent les suivants ne doivent plus avoir d'offset vertical ce qui donne :
Code:
'Copie des valeurs du formulaire vers l'onglet "Source"
'Sheets("Source").Range("A65536").End(xlUp).Offset (1, 0).Value = Annee
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 1).Value = Mois
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 2).Value = Service

'Cette ligne en plus de copier, met la 1ere lettre de chaque mot en majuscule
'par Application.Proper(Me!Nom_prenom)
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 3).Value = Application.Proper(Me!Nom_prenom)

'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 4).Value = delai
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 5).Value = Lieu
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 6).Value = Projet
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 7).Value = Nature_tache
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 8).Value = Entite_facturer
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 9).Value = Duree_jours
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 10).Value = Transports
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 11).Value = Logistique
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 12).Value = Divers
'Sheets("Source").Range("A65536").End(xlUp).Offset (0, 15).Value = Montant_Frais

A tester tout de même
de plus tu as la solution de bhbh qui me parait excellente
 

Discussions similaires

Réponses
6
Affichages
178
Réponses
1
Affichages
203
Réponses
2
Affichages
151

Statistiques des forums

Discussions
312 581
Messages
2 089 919
Membres
104 307
dernier inscrit
Diet