Sélections cellules copies sur autres feuille

Bonjour,

Je rencontre quelques soucis, pour utiliser une macro me permettant de récupérer des cellules discontigues d'une feuille

et les afficher sur une ligne sur une autre feuille.

Je parviens à sélectionner et copier les deux premières cellules (qui sont sur la même ligne), en revanche je sèche pour les

cellules (-de la première feuille) se trouvant sur divers lignes.

Je souhaite sélectionner et copier les cellules de la feuille1:

B1 / C1 / B3 / C16 / C17 / C18 / C19 / C20 / E21 / E22 / F25

et les afficher sur la ligne 38 de la Feuille2, les une après les autres. Bien entendu l'action peut se répéter et donc réecrire les

dites cellules à la ligne 39, puis 40 etc etc. (le script suivant permet de le faire)

Merci d'avance.

Sub Test1() ' ' Test1 Macro Dim dest As Range 'déclare la varialbe dest (cellule de DESTination) With Sheets("Liste_éleves") 'prend en compte l'onglet "Liste_éleves" 'définit la cellule de destination dest (A38 si A38 est vide, sinon la première ligne vide rencontrée) Set dest = IIf(.Range("A38").Value = "", .Range("A38"), .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) End With 'fin de la prise en compte de l'onglet "Liste_éleves" Sheets("Fiche_observation_à_remplir").[B1, C1].Select Selection.Copy dest End Sub

Bonjour,

Voici une possibilité :

Sub Galopin()
Dim iRD%, WsC As Worksheet, WsS As Worksheet
Set WsC = Sheets("Liste_éleves")                'feuille Cible
Set WsS = Sheets("Fiche_observation_à_remplir") 'feuille Source
iRD = WsC.Cells(Rows.Count, 1).End(xlUp)(2).Row 'Ligne Destination
   With WsS
      .[B1, C1].Copy WsC.Cells(iRD, 1)
      .[B3].Copy WsC.Cells(iRD, 4)
         For i = 1 To 5
            .Range("C" & 16 + i).Copy WsC.Cells(iRD, 12 + i)
         Next
      .[C21].Copy WsC.Cells(iRD, 18)
      .[C22].Copy WsC.Cells(iRD, 19)
      .[E25].Copy WsC.Cells(iRD, 20)
   End With
End Sub

A+

Bonjour, et merci beaucoup pour le script.

J'ai quelques cellules comprenant des formules dont la somme n'est pas copié, ceci dit, je me retrouve avec un fichier définitif ou les cellules à copier ont quelque peu été changé.

Si cela ne vous dérange pas trop, je vous redonne les données exactes:

Document comprenant 7 feuilles.

J'ai besoin que les cellules de la feuille 1 (Parcours_N°1_Fiche_observation) soient copier sur la feuille 7(Liste_éleves) à partir de la ligne 5.

Les cellules concernées sont :

(Parcours_N°1_Fiche_observation)

B1 / C1 / E3 / B4 / B5 / B2 / C2 / B17 / D19 / B21 /

sur

(Liste_éleves) (attention certaines cellules de destinations sont discontigues)

A5 / B5 / C5 / D5 / F5 / G5 / H5 / I5 / K5 / O5 /

J'ai bien essayé de modifier votre précèdent script, afin de l'adapté à mes besoins définitifs, mais sans succès.

D'avance merci.

Cordialement.

Bonsoir,

Voici le script corrigé en conséquence.

Sub Galopin()
Dim iRD%, WsC As Worksheet, WsS As Worksheet
Set WsC = Sheets("Liste_éleves")                   'feuille Cible
Set WsS = Sheets("Parcours_N°1_Fiche_observation") 'feuille Source
iRD = WsC.Cells(Rows.Count, 1).End(xlUp)(2).Row    'Ligne Destination
   With WsS
      .[B1].Copy WsC.Cells(iRD, 1)
      .[C1].Copy WsC.Cells(iRD, 2)
      .[E3].Copy WsC.Cells(iRD, 3)
      .[B4].Copy WsC.Cells(iRD, 4)
      .[B5].Copy WsC.Cells(iRD, 6)
      .[B2].Copy WsC.Cells(iRD, 7)
      .[C2].Copy WsC.Cells(iRD, 8)
      .[B17].Copy WsC.Cells(iRD, 9)
      .[D19].Copy WsC.Cells(iRD, 11)
      .[B21].Copy WsC.Cells(iRD, 15)
   End With
End Sub

Pour des cellules dispersés au départ et à l'arrivée le mieux est d'écrire un ligne par cellule à copier au départ et en face la cellule de destination. (le dernier chiffre est la colonne de destination)

Le script s'exécute sur la ligne au niveau de la première cellule libre de la colonne A Donc pour commencer ligne 5 il faut vider les lignes 5 a 29 et les lignes 37 et suivantes.

A+

Merci beaucoup, pour le script et votre réactivité.

les cellules B17 et B21 ont des formules.

La copie n'indique pas le résultat de ces formules.

Auriez vous une idée ?

Cordialement.

Bonjour,

Copy... copie la cellule ! Si tu ne veux récupérer que la valeur une simple égalité suffit :

Sub Galopin()
Dim iRD%, WsC As Worksheet, WsS As Worksheet
Set WsC = Sheets("Liste_éleves")                   'feuille Cible
Set WsS = Sheets("Parcours_N°1_Fiche_observation") 'feuille Source
iRD = WsC.Cells(Rows.Count, 1).End(xlUp)(2).Row    'Ligne Destination
   With WsS
      .[B1].Copy WsC.Cells(iRD, 1)
      .[C1].Copy WsC.Cells(iRD, 2)
      .[E3].Copy WsC.Cells(iRD, 3)
      .[B4].Copy WsC.Cells(iRD, 4)
      .[B5].Copy WsC.Cells(iRD, 6)
      .[B2].Copy WsC.Cells(iRD, 7)
      .[C2].Copy WsC.Cells(iRD, 8)
      WsC.Cells(iRD, 9) = .[B17]
      .[D19].Copy WsC.Cells(iRD, 11)
      WsC.Cells(iRD, 15) = .[B21]
   End With
End Sub

A+