Excel - Copier valeurs avec conditions

Je souhaiterai appliquer cette macro à d'autre classeur comprenant plusieurs feuilles mais je ne vois pas les mofifications à apporter dans ce but. Je pense qu'il est également important que je précise que la cellule dans laquelle on rentre D4 (par exemple) ne sera pas forcément toujours à la méme place selon le classeur Excel.
Peux tu me donner un dernier coup de pouce?

Ouvre l'éditeur VB (touche Alt + F11) tu trouveras le code dans "Feuil1" et module1.


Voilà le code commenté.
Dans "Feuil1":

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim vTemp As String   'pour la colonne température 
Dim LH As String          'pour la colonne lecture haute 
Dim LB As String          'pour la colonne lecture basse 

    'On intercepte la saisie de l'utilisateur  
    'Si ce n'est pas la cellule C45 on sort de la procédure 
    If Target.Address <> "$C$45" Then Exit Sub 

    'On efface le contenu du tableau de report 
    Range("C47:H86").ClearContents 
    ' 
    'On affecte les colonnes concernées en fonction de la saisie 
    Select Case UCase(Target.Value) 
        Case "D1" 
            vTemp = "A" 
            LH = "C" 
            LB = "E" 
        Case "D2" 
            vTemp = "G" 
            LH = "I" 
            LB = "K" 
        Case "D3" 
            vTemp = "M" 
            LH = "O" 
            LB = "Q" 
        Case "D4" 
            vTemp = "S" 
            LH = "U" 
            LB = "W" 
        Case "D5" 
            vTemp = "Y" 
            LH = "AA" 
            LB = "AC" 
        Case "D6" 
            vTemp = "AE" 
            LH = "AG" 
            LB = "AI" 
    End Select 
    ' 
    'On passe les colonnes à la fonction qui affiche les données dans le tableau de report 
    Call Module1.AfficheDonnee(vTemp, LH, LB) 

End Sub

Dans le module1:

Sub AfficheDonnee(ByVal pTemp As String, ByVal pLH As String, ByVal pLB As String) 
Dim ws As Worksheet      'Objet feuille 
Dim lig As Long                  'indice de ligne 
Dim ligne As Long              'indice de ligne 


    'Déclaration de l'objet feuille (ici la feuille 1) 
    Set ws = Worksheets(1) 
    ' 
    'Pour la température 
    lig = 3  'première ligne à lire 
    ligne = 47  'première ligne à écrire 
    With ws 
        'Tant que la cellule n'est pas vide 
        While .Range(pTemp & lig).Value <> "" 
            On copie dans le tableau report le contenu de la cellule 
            .Range("C" & ligne).Value = .Range(pTemp & lig).Value 
            'On passe à la ligne suivante en lecture 
            lig = lig + 1 
            'On passe à la ligne suivante en écriture 
            ligne = ligne + 1 
        Wend 
         
        'Idem pour la lecture Haute 
        lig = 3 
        ligne = 47 
        While .Range(pLH & lig).Value <> "" 
            .Range("E" & ligne).Value = .Range(pLH & lig).Value 
            lig = lig + 1 
            ligne = ligne + 1 
        Wend 
         
        'Idem pour la lect(ure Basse 
        lig = 3 
        ligne = 47 
        While .Range(pLB & lig).Value <> "" 
            .Range("G" & ligne).Value = .Range(pLB & lig).Value 
            lig = lig + 1 
            ligne = ligne + 1 
        Wend 
    End With 
End Sub

Il te suffit d'adapter ça aux autres classeurs.

;o)

J'ai une question Polux,
Comment as tu pu soigner la présentation de ton code sur le forum? Quand je veux écrire quelque chose en décalé (espaces au début de la ligne), après la validation de ma réplique tout s'aligne au début de ligne (l'espace au début des lignes s'efface)
Merci!

Salut commentcamarcheeay,

Dans le cadre pour écrire, tu as 4 balises : B I S et <> ...
Pour le code tu utilises <> c'est tout ...
;o)

C'était alors aussi simple que ça! lol
Merci pour la réponse!

Voici le code principal de la macro qu'il faut savoir appeler à partir des cellules :

Function findAddress(myCell As Range, myField As Range) As String
'macro permettant de trouver l'adresse de la cellule contenant la valeur de "myCell" dans un champ "myField"
'si le résultat de la recherche est négatif, la fonction renvoie l'adresse de la cellule qui l'a appelée.
Dim cell As Range
For Each cell In Intersect(myField.Worksheet.UsedRange, myField)
If cell = myCell Then
findAddress = cell.Address
Exit Function
End If
Next
findAddress = Application.Caller.Address
End Function

Function offCell(myResBenchMark As Range, myBenchMark As Range) As Variant
'macro permettant de copier la cellule en respectant le même décalage :
'- une fois entre l'entête du tableau des données et la cellule concernée
'- une fois entre la cellule contenant la valeur recherchée et la cellule qui reçoit le résultat
On Error GoTo er
offCell = myResBenchMark.Worksheet.Cells(myResBenchMark.Row + Application.Caller.Row - myBenchMark.Row, myResBenchMark.Column + Application.Caller.Column - myBenchMark.Column)
If offCell = 0 Then offCell = ""
Exit Function
er:
offCell = ""
End Function

Dans les cellules concernées, il suffit de rentrer la formule suivante :
=offcell(INDIRECT(findaddress($C$45;$1:$1));$C$45)