Copier valeur cellule feuille 1 sur plusieurs lignes feuille 2

Bonjour,

Je joins mon document car cela sera beaucoup plus simple pour comprendre.

Feuille FAM est une feuille où je remplis des informations privée puis je saisi des participants

Mon problème c'est que je sais copier des cellules une à une et une plage, mais je ne sais pas remplir les cases des colonnes A-G feuille report avec la même valeur et la recopier jusqu'à la dernière ligne où il y a quelque chose (voir doc PDF pour explication plus claire)

7image.pdf (96.77 Ko)

Le code que j'ai déjà fait est le suivant :

'Définit sur quelle ligne de Report les données seront copiées
ligne = Sheets("Report").Range("h" & Rows.Count).End(xlUp).Offset(1).Row

'Rapporte les infos dans Report
Sheets("Report").Range("A" & ligne).Value = Sheets("FAM").Range("B3").Value
Sheets("Report").Range("B" & ligne).Value = Sheets("FAM").Range("B9").Value
Sheets("Report").Range("C" & ligne).Value = Sheets("FAM").Range("B14").Value
Sheets("Report").Range("D" & ligne).Value = Sheets("FAM").Range("B15").Value
Sheets("Report").Range("E" & ligne).Value = Sheets("FAM").Range("B16").Value
Sheets("Report").Range("F" & ligne).Value = Sheets("FAM").Range("B17").Value
Sheets("Report").Range("G" & ligne).Value = Sheets("FAM").Range("B23").Value
Sheets("FAM").Range("B29:H78,M29:M78").Select
Selection.Copy
Sheets("Report").Select
Range("H" & ligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


End Sub

9exemple.xlsm (52.73 Ko)

J'ai de la peine à bien exprimer ce que je souhaite c'est peut-être pour cela que je n'ai rien trouvé.

Si je fais une sélection de 50 lignes c'est que je trouvais que c'était plus simple car je ne sais pas sélectionner juste les lignes qui ont un contenu sur plusieurs colonnes qui ne se touchent pas

Merci pour votre aide

Bonsoir

Sans le mot de passe impossible de travailler

Bonjour le fil

Pas forcément besoin du mot de passe de la feuille "FAM", mais merci d'y faire attention en déposant des fichiers

Voici le code corrigé, pensez à mettre "Option Explicit" en entête de module et définissez vos variables
vous aurez beaucoup moins de problèmes par la suite

Option Explicit

Sub Save_FAM()
  Dim Cels As Range
  Dim Ligne As Long, FirstLig As Long

  'contrôles que toutes les cases soient remplies Si pas remplies alors MsgBox et fin de sub
  Set Cels = Sheets("FAM").Range("B3:B5,B7:B8,B10:B12,B14:B18,B20:B23")
  If Application.WorksheetFunction.CountA(Cels) < Cels.Count Then
    MsgBox "B4, B5, B7, B8, B10-B12, B14-B18 or B20-B23" _
      & vbLf & "must contain a value"
    Exit Sub
  End If

  With Sheets("Report")
    'Définit sur quelle ligne de Report les données seront copiées
    Ligne = .Range("H" & Rows.Count).End(xlUp).Offset(1).Row
    FirstLig = Ligne
    'Rapporte les infos dans Report
    .Range("A" & Ligne).Value = Sheets("FAM").Range("B3").Value
    .Range("B" & Ligne).Value = Sheets("FAM").Range("B10").Value
    .Range("C" & Ligne).Value = Sheets("FAM").Range("B14").Value
    .Range("D" & Ligne).Value = Sheets("FAM").Range("B15").Value
    .Range("E" & Ligne).Value = Sheets("FAM").Range("B16").Value
    .Range("F" & Ligne).Value = Sheets("FAM").Range("B17").Value
    .Range("G" & Ligne).Value = Sheets("FAM").Range("B23").Value
    ' Copier
    Sheets("FAM").Range("B29:H78,M29:M78").Copy
    .Range("H" & Ligne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    ' Trouver la dernière ligne des données remplies
    Ligne = .Range("I" & Rows.Count).End(xlUp).Row
    ' Inscrire le numéro de facture sur toutes les lignes
    .Range("A" & FirstLig & ":G" & Ligne).FillDown
  End With
End Sub

A+

@yal_Excel : Toutes mes excuses c'est un document que j'ai reçu :( J'aurai du penser à recopier dans un nouveau document.

@BrunoM45 : Merci beaucoup, je vais aller voir tout cela en détail.
Si je comprends bien, les données ont été copiée sur la première ligne puis cette lignes est copiée vers le bas.

Merci pour l'idée :)

@BrunoM45

J'ai un petit problème avec le code.
En effet, si je n'ai qu'une ligne d'information dans ma feuille FAM, le code ne reprend pas le bon numéro de facture.
Si j'ai plus qu'une personne le code fonctionne super bien.
exemple avec plusieurs personnes :

image

Résultat après avoir fait tourner le VBA :

image

Le problème se pose quand j'ai qu'une seule ligne :

image

Je fais tourner le VBA et j'arrive à la problématique suivante :
Au lieu de prendre le numéro 202266 le code a copié le numéro 202277 qu'il y avait avant
Quel serait la solution ?
Je pense que c'est du au fait qu'on copie les informations vers le bas, mais je ne suis pas sûr

image

D'avance MERCI pour l'aide précieuse.

Rafael

Bonjour Rafael,

Comme ça, je ne vois pas pourquoi,
Il faudrait nous déposer un fichier anonymisé avec les nouvelles données

A+

Le problème se présente aussi sur les colonnes B, C, D, E, F, G
Je ne l'avais pas vu car c'était les mêmes infos, mais un autre test les a mis en lumière.

Re,

Voici la partie du code à remplacer

  With Sheets("Report")
    'Définit sur quelle ligne de Report les données seront copiées
    Ligne = .Range("H" & Rows.Count).End(xlUp).Offset(1).Row
    FirstLig = Ligne
    'Rapporte les infos dans Report
    .Range("A" & Ligne).Value = Sheets("FAM").Range("B3").Value
    .Range("B" & Ligne).Value = Sheets("FAM").Range("B10").Value
    .Range("C" & Ligne).Value = Sheets("FAM").Range("B14").Value
    .Range("D" & Ligne).Value = Sheets("FAM").Range("B15").Value
    .Range("E" & Ligne).Value = Sheets("FAM").Range("B16").Value
    .Range("F" & Ligne).Value = Sheets("FAM").Range("B17").Value
    .Range("G" & Ligne).Value = Sheets("FAM").Range("B23").Value
    ' Dernière ligne visible de facturation
    dLigFac = Sheets("FAM").Range("B" & Rows.Count).End(xlUp).Row
    ' Copier la/les lignes
    Sheets("FAM").Range("B29:H" & dLigFac & ",M29:M" & dLigFac).Copy
    ' Coller la valeur
    .Range("H" & Ligne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    ' Trouver la dernière ligne des données remplies
    Ligne = .Range("I" & Rows.Count).End(xlUp).Row
    ' Inscrire le numéro de facture sur toutes les lignes
    If Ligne > FirstLig Then
      .Range("A" & FirstLig & ":G" & Ligne).FillDown
    End If
  End With

A tester

Hello,
Merci,
Lorsque je referai une saisie, je ferai un feedback.
Actuellement je suis sur un autre projet.

Merci mille fois

Bonsoir,

Me voilà a tester et je me retrouve face à ce problème

image

J'ai juste remplacé FAM par MGP.B pour avoir un sub pour mon 5ème onglet, mais cela ne fonctionne pas ...
Possible de m'expliquer ?

Mille merci

Bonsoir Rafkiller,

Je pense que le message d'erreur est explicit non

Pour moi "dLigFac" n'est pas défini

A+

Bonsoir Bruno,

Merci pour votre retour.

Mais j'ai repris directement du code que vous m'aviez donné dans le message du 03.05. je n'ai donc pas vu cela
(code donné)
Pardonnez ma "novicerie"

  With Sheets("Report")
    'Définit sur quelle ligne de Report les données seront copiées
    Ligne = .Range("H" & Rows.Count).End(xlUp).Offset(1).Row
    FirstLig = Ligne
    'Rapporte les infos dans Report
    .Range("A" & Ligne).Value = Sheets("FAM").Range("B3").Value
    .Range("B" & Ligne).Value = Sheets("FAM").Range("B10").Value
    .Range("C" & Ligne).Value = Sheets("FAM").Range("B14").Value
    .Range("D" & Ligne).Value = Sheets("FAM").Range("B15").Value
    .Range("E" & Ligne).Value = Sheets("FAM").Range("B16").Value
    .Range("F" & Ligne).Value = Sheets("FAM").Range("B17").Value
    .Range("G" & Ligne).Value = Sheets("FAM").Range("B23").Value
    ' Dernière ligne visible de facturation
    dLigFac = Sheets("FAM").Range("B" & Rows.Count).End(xlUp).Row
    ' Copier la/les lignes
    Sheets("FAM").Range("B29:H" & dLigFac & ",M29:M" & dLigFac).Copy
    ' Coller la valeur
    .Range("H" & Ligne).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
    ' Trouver la dernière ligne des données remplies
    Ligne = .Range("I" & Rows.Count).End(xlUp).Row
    ' Inscrire le numéro de facture sur toutes les lignes
    If Ligne > FirstLig Then
      .Range("A" & FirstLig & ":G" & Ligne).FillDown
    End If
  End With
Rechercher des sujets similaires à "copier valeur feuille lignes"