[XL-2007] Copier-coller des cellules pour alimenter un tableau [Résolu]

[DidierBoz]

Bonjour,

Je vous expose la situation et il y aura le code en fin de message.

J'ai un résultat de calcul en S14 (calcul d'une moyenne) - De même pour les cellules S20 et S27 - ces cellules ne changent pas mais leur contenu varie à chaque nouvelle série d'entrées

Les entrées sont les réponses d'un questionnaire et le but est de traiter environ une trentaine de questionnaires. A chaque participant correspond le triplet (S14-S20-S27)

Je renvoie la valeur de chaque cellule respectivement en W2-W3-et W4.
en sortie au participant 1 correspond le triplet (W2-W3-W4)


Ma macro fonctionne bien pour un seul participant (j'ai procédé par un enregistrement macro)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
Sub Traitement()
' Traitement Macro
' Touche de raccourci du clavier: Ctrl+h
'copie 1ere valeur
    Range("S14").Select
    Selection.Copy
    Range("W2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'copie 2eme valeur
    Range("S20").Select
    Application.CutCopyMode = False
    Selection.Copy
'copie 3eme valeur
    Range("W3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=6
    Range("S27").Select
    Application.CutCopyMode = False
    Selection.Copy

Mais comment modifier le code pour qu'au participant 2 je puisse copier les valeurs (S14-S20-S27) vers (X2-X3-X4) ? et faire cela pour environ 30 participants

Là est mon problème d'automatisation de mon programme excel et sur le net aucune solution qui corresponde vraiment à mon cas.

Cela est pour mon travail de qualiticien en Centre de Lutte Contre le Cancer qui est une clinique à but non lucratif. (et oui çà existe !!!!) - taper CLCC sur le net
En final ce programme excel va me conduire à un indicateur qualité.

Je vous remercie pour votre aide.

[hben1961]

Bonjour à tous,

Un essai avec un petit code fait à la hate (en supposant que les cellules S14, S20 et S27 changent selon le numéro de participant dans la cellule A1):

Code :

1
2
3
4
5
6
7
8
9
Sub Traitement()
Dim I As Integer
For I = 1 To 30
  [A1] = I
    Cells(2, 21 + I).Value = [S14].Value
    Cells(3, 21 + I).Value = [S20].Value
    Cells(4, 21 + I).Value = [S27].Value
Next I
End Sub

Cordialement

[DidierBoz]

Bonjour et merci pour la réponse,

Ce code ne peut pas marcher car il propose une boucle de 1 à 30.

Je m'explique:
Pour le participant 1 je remplis les réponses. Une fois le questionnaire rempli mon programme me donne le triplet (S14;S20;S27).
Le code que j'ai créé me permet de copier de former l'autre triplet (W2;W3;W4)

Je sauvegarde

Je prend le second questionnaire; je remplis les réponses et j'obtiens un nouveau triplet (S14;S20;S27) --- si la position est identique les valeurs diffèrent du premier participant.

Je souhaite que mon code me permette de copier les valeurs du triplet vers un nouveau triplet (X2;X3;X4) et ainsi de suite tant que j'ai des questionnaires.

En final j'aurais une matrice W2:X4 (pour deux participants)

Comment modifier le code que j'ai créé pour obtenir ce résultat?

Il me faudrait une solution clé en main pour deux participant par exemple.

Merci de votre aide

[78chris]

Bonjour

Envoyé par DidierBoz

...
Pour le participant 1 je remplis les réponses. Une fois le questionnaire rempli mon programme me donne le triplet (S14;S20;S27).
Le code que j'ai créé me permet de copier de former l'autre triplet (W2;W3;W4)
Je sauvegarde
Je prend le second questionnaire

Il est où ce second questionnaire ? C'est l'élément clé !
Tu ne dis pas si tu as un ou plusieurs classeurs...

[bbil]

Voilà un petit code qui cherche la prochaine colonne disponible pour y copier tes données :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Sub Traitement()
 Dim sh As Worksheet
 Dim ic As Integer 'Colonne destination
 Set sh = ThisWorkbook.Worksheets("Feuil3") '>>>>>> A ADAPTER >>>>>> Préciser la feuille de calcul concernée 
 ic = sh.Range("W2").Column 'Récupére numéro de colonne W..
 While Application.CountA(sh.Range(sh.Cells(2, ic), sh.Cells(4, ic))) <> 0 'Se position sur prochaine colonne libre
   ic = ic + 1
 Wend
 Debug.Print "Destination" & sh.Cells(2, ic).Address
  sh.Cells(2, ic) = sh.Range("S14")
  sh.Cells(3, ic) = sh.Range("S20")
  sh.Cells(3, ic) = sh.Range("S27")
End Sub

[DidierBoz]

Envoyé par 78chris

Bonjour
Il est où ce second questionnaire ? C'est l'élément clé !
Tu ne dis pas si tu as un ou plusieurs classeurs...

Bonjour,

Le questionnaire est un formulaire papier que les participants ont rempli; je le prends dans ma petite mimine et je reporte les valeurs dans mon tableau Excel.

[DidierBoz]

Envoyé par bbil

Voilà un petit code qui cherche la prochaine colonne disponible pour y copier tes données :

Code :

Bonjour,
Est-ce que ce code remplace celui que j'ai créé?
Cordialement

[bbil]

oui.. remplace tout ton code par cela ..

[DidierBoz]

Envoyé par bbil

Voilà un petit code qui cherche la prochaine colonne disponible pour y copier tes données :

Code :

Merci de ne pas tenir compte de mon message; çà marche du feu de D...
A l'avant dernière ligne j'ai corrigé sh.cells (4...) et non 3.

Je vous remercie de votre aide.
Comme généralement je ne me contente pas d'une solution sans comprendre ce que je fais, pourriez-vous m'expliquer ligne par ligne en dans la langue de Shakespare non de Molière ce que le code fait?
Je suis en train d'apprendre en lisant un tutorial donc je vais progresser, mon but n'étant pas de devenir un spécialiste.

Merci à vous encore un fois.
a bientôt sur ce forum car j'aurais certainement encore besoin de la communauté pour mon projet de tableau de bord qualité
DidierBoz

[hben1961]

Bonjour à tous,

Une autre code plus simple (pas de boucles)

Code :

1
2
3
4
5
6
7
8
Option Explicit
Sub Traitement()
Dim I As Integer
  I = Application.WorksheetFunction.CountA(Range("W2:IV2")) + 1
    Cells(2, 22 + I).Value = [S14].Value
    Cells(3, 22 + I).Value = [S20].Value
    Cells(4, 22 + I).Value = [S27].Value
End Sub

Cordialement