ajout automatique donnée sous condition HELP!! VBA

[djodc]

Bonjour à tous,

j'aurais besoin d'aide pour construire un fichier EXCEl. voila ce dont j'aurais besoin si possible:

j'ai deja une macro qui transpose mes données de la feuil1 a partir de la colonne C jusqu'a la colonne R sur la feuill2 dans la colonne Q.
je vais donc avoir par exemple mes données en C8:R8 de la feuil1 qui vont être copier/coller en Q5:Q21 de la feuil2.

mon besoin est qu'il faudrait qu'a chaque fois qu'une donnée est coller dans la colonne Q que sa valeur correspondante de la colonne A feuil1 soit copier coller en colonne D sur la même ligne de la feuil2.
si on reprend l'exemple precedent pour mes données en C8:R8 de la feuil1 j'aurais a chaque fois la même valeur en A8 et il faudrait que cette valeur soit copier/coller en D5:Q21 de la feuil2 pour correspondre au valeur copier/coller en Q5:Q21 de la même feuil.

et ainsi de suite pour faire la même chose pour chaque ligne de la feuil1 non vide

j'espère être assez claire :s

Merci mille fois,

djo

 

[Lone-wolf]

Bonjour djo et bienvenue sur XLD

D'après ce que j'ai compris: une fois la ligne remplie en Feuil1, copier la ligne en Feuil2 et rajouter la référence de la colonne A de la feuille 1. Si c'est celà, regarde le fichier si ça te convient. Fait un test avec une nouvelle ligne pour voir le résultat.

 

[djodc]

Bonjour djo et bienvenue sur XLD

D'après ce que j'ai compris: une fois la ligne remplie en Feuil1, copier la ligne en Feuil2 et rajouter la référence de la colonne A de la feuille 1. Si c'est celà, regarde le fichier si ça te convient. Fait un test avec une nouvelle ligne pour voir le résultat.

Bonjour lone-wolf

Merci beaucoup pour ton aide!! cela represente bien mon besoin! par contre après avoir effectué un test et modifier les données seul la deuxième ligne est reprise dans le copier coller

Merci infiniment pour ton aide

djo

 

[Lone-wolf]

Bonjour djo

Je ne sais pas comment tu t'y ai pris. Chez moi, à chaque nouvelle ligne, les données s'inscrivent à la suite. Quelle version d'Excel tu utilise?

 

[djodc]

Bonjour djo

Je ne sais pas comment tu t'y ai pris. Chez moi, à chaque nouvelle ligne, les données s'inscrivent à la suite. Quelle version d'Excel tu utilise?

Merci pour ton retour plus que rapide Lone-wolf,

Je suis sur Excel 2010! en fait j'ai supprimé les données de la ligne 8 et 9 et en ai renseigné des nouvelles! mais le copier/coller se réalise unique ment pour la ligne 9. comme tu viens de me le dire seul la dernière ligne renseignée est copier/coller alors qu'il faudrait l'intégralité du tableau a chaque fois que je clique sur le bouton!

Merci beaucoup pour ton temps

 

[Lone-wolf]

Re

reprend le fichier que j'ai mis en le renommant. Efface les données dans les 2 feuilles et recommence, ensuite donne moi un retour. Oubien tu as laissé les références 8 et 9 dans la 2 feuille.

 

[djodc]

Re

reprend le fichier que j'ai mis en le renommant. Efface les données dans les 2 feuilles et recommence, ensuite donne moi un retour. Oubien tu as laissé les références 8 et 9 dans la 2 feuille.

C'est bon!! au top!

Merci encore pour ton aide et ton temps!

 

[Lone-wolf]

Re

Pour éviter d'avoir le même numéro de référence dans la feuille 1, ajoute ceci dans le module de la feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim derlig As Long, cel As Range

    If Not Intersect(Target, Columns("B:B")) Is Nothing Then
         derlig = Range("a" & Rows.Count).End(xlUp).Row
         For Each cel In Range("a8:a" & derlig)
            If Target.Offset(0, -1) = cel.Offset(-1, 0).Value Then: MsgBox "     Ce numéro est déjà inscrit." & vbCrLf _
             & vbCrLf & "     Saisissez un autre numéro", , "ERREUR": Target.Offset(0, -1).ClearContents: Exit Sub
        Next cel
    End If
End Sub

EDIT: Et pour rappel du dernier numéro de la colonne R et insertion automatique des numéros

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim derlig As Long, i As Long, cel As Range
  If Not Intersect(Target, Columns("B:B")) Is Nothing Then
  derlig = Range("a" & Rows.Count).End(xlUp).Row
  For Each cel In Range("a8:a" & derlig)
  If Target.Offset(0, -1) = cel.Offset(-1, 0).Value Then: MsgBox "  Ce numéro est déjà inscrit." & vbCrLf _
  & vbCrLf & "  Saisissez un autre numéro", , "ERREUR": Target.Offset(0, -1).ClearContents: Exit Sub
  Next cel
  End If
   
  If Not Intersect(Target, Columns("D:D")) Is Nothing Then
  For i = 0 To 14
  Target.Offset(0, i) = Format(Target.Offset(0, i - 1) + 1, "0")
  Next i
  Range("e3") = Target.Offset(0, 14)
  End If
End Sub

 

[djodc]

Re

Pour éviter d'avoir le même numéro de référence dans la feuille 1, ajoute ceci dans le module de la feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim derlig As Long, cel As Range

    If Not Intersect(Target, Columns("B:B")) Is Nothing Then
         derlig = Range("a" & Rows.Count).End(xlUp).Row
         For Each cel In Range("a8:a" & derlig)
            If Target.Offset(0, -1) = cel.Offset(-1, 0).Value Then: MsgBox "     Ce numéro est déjà inscrit." & vbCrLf _
             & vbCrLf & "     Saisissez un autre numéro", , "ERREUR": Target.Offset(0, -1).ClearContents: Exit Sub
        Next cel
    End If
End Sub

EDIT: Et pour rappel du dernier numéro de la colonne R et insertion automatique des numéros

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim derlig As Long, i As Long, cel As Range
  If Not Intersect(Target, Columns("B:B")) Is Nothing Then
  derlig = Range("a" & Rows.Count).End(xlUp).Row
  For Each cel In Range("a8:a" & derlig)
  If Target.Offset(0, -1) = cel.Offset(-1, 0).Value Then: MsgBox "  Ce numéro est déjà inscrit." & vbCrLf _
  & vbCrLf & "  Saisissez un autre numéro", , "ERREUR": Target.Offset(0, -1).ClearContents: Exit Sub
  Next cel
  End If
  
  If Not Intersect(Target, Columns("D:D")) Is Nothing Then
  For i = 0 To 14
  Target.Offset(0, i) = Format(Target.Offset(0, i - 1) + 1, "0")
  Next i
  Range("e3") = Target.Offset(0, 14)
  End If
End Sub

Ca marche Merci encore lone wolf pour ton aide