Retranscription automatique de cellules

Bonsoir tout le monde et un grand merci de bien vouloir m'aider.

Je suis un débutant en Excell et mes neurones sont agés de 70 ans !!!

Je suis allé chercher une solution sur le forum et j'ai essayé EN VAIN d'adapter une application existante.

Mon problème :

Je souhaite mettre à jour une feuille d'un classeur sur base d'une cellule commune à une autre feuille.

Je joins un classeur pour mieux expliquer mon problème.

Un tout grand merci à tous ceux qui voudront bien me lire et m'aider

Sub retranscription()

Dim i As Integer, j As Integer, Référence As Long

Application.ScreenUpdating = False

Range("A2:S" & Rows.Count).ClearContents

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row

Référence = CLng(Range("A" & i))

j = Application.WorksheetFunction.Match(CLng(Référence), Sheets("Total").Range("R:R"), 0)

Sheets("Total").Range("A" & j & ":S" & j).Copy Range("A" & i)

Next i

End Sub

bonsoir,

après quelques modifications, à tester

Sub retranscription()
Dim i As Integer, j As Integer, Référence As Long
Set ws = Worksheets("2014")
Application.ScreenUpdating = False

ws.Range("A2:S" & Rows.Count).ClearContents

For i = 2 To ws.Range("T" & Rows.Count).End(xlUp).Row
    Référence = CLng(ws.Range("T" & i))
    j = Application.WorksheetFunction.Match(CLng(Référence), Sheets("Total").Range("T:T"), 0)
    Sheets("Total").Range("A" & j & ":S" & j).Copy ws.Range("A" & i)
Next i
Set ws = Nothing
End Sub

UN TOUT GRAND MERCI.

VOUS AVEZ TROUVE.

JE RECOIS UN MESSAGE EN FIN DE PROGRAMME ..... UNE X BLANCHE DANS UN CERCLE ROUGE AVEC LE CHIFFRE 400.

POUVEZ VOUS ME DIRE DE QUOI IL S AGIT ?

ENCORE MERCI MONSIEUR ET BONNE SOIREE

bonsoir,

cette erreur survient lorsqu'une référence n'est pas trouvée dans la feuille total, voici une correction qui devrait traiter ce cas.

ps : pas de raison d'avoir une réponse en majuscules ... (c'est perçu comme une colère, un mécontentement, une engueulade, ...), je ne pense pas mériter cela

Sub retranscription()
Dim i As Integer, j As Integer, Référence As Long
Set ws = Worksheets("2014")
Application.ScreenUpdating = False

ws.Range("A2:S" & Rows.Count).ClearContents

For i = 2 To ws.Range("T" & Rows.Count).End(xlUp).Row
    Référence = CLng(ws.Range("T" & i))
    j = 0
    On Error Resume Next
    j = Application.WorksheetFunction.Match(CLng(Référence), Sheets("Total").Range("T:T"), 0)
    On Error GoTo 0
    If j <> 0 Then Sheets("Total").Range("A" & j & ":S" & j).Copy ws.Range("A" & i)
Next i
Set ws = Nothing
End Sub

Sorry Monsieur,

Mon clavier est resté bloqué sur la majuscule. N'y voyez aucun mécontentement, que du contraire, je suis particulièrement heureux que vous ayez trouvé la solution.

Un tout grand merci encore et bonne soirée

J'ai essayé avec votre correction,, ,je n'ai plus de message donc je suis ravi

Encore une fois merci

Bonsoir Monsieur,

Hier vous m'avez rendu un sacré service après avoir mis au point le petit

programme ci-après :

Sub retranscription()

Dim i As Integer, j As Integer, Référence As Long

Set ws = Worksheets("2014")

Application.ScreenUpdating = False

ws.Range("A2:S" & Rows.Count).ClearContents

For i = 2 To ws.Range("T" & Rows.Count).End(xlUp).Row

Référence = CLng(ws.Range("T" & i))

j = 0

On Error Resume Next

j = Application.WorksheetFunction.Match(CLng(Référence),

Sheets("Total").Range("T:T"), 0)

On Error GoTo 0

If j <> 0 Then Sheets("Total").Range("A" & j & ":S" & j).Copy

ws.Range("A" & i)

Next i

Set ws = Nothing

End Sub

Tout fonctionne particulièrement bien. Mais il me semble que le programme

passe en revue toute la colonne T même lorsque cette colonne est vide (je

veux dire même lorsque la colonne ne renferme pas de chiffre).

Est-il possible d'adapter le programme pour que la boucle s'arrête

lorsqu'il n'y a plus de chiffres dans ladite colonne ?

Je ne veux pas donner l'impression d'abuser de votre gentillesse et sachez

que je suis déjà particulièrement heureux de ce que vous avez fait pour

moi.

Je vous souhaite une bonne soirée et encore une fois MERCI

bonsoir, je réponds sur le forum à la question qui a été posée en MP.

La macro passe en revue tous les éléments de la colonne T jusqu'à la dernière cellule contenant une valeur. Si par hasard il y a une valeur en toute fin de colonne T, toutes les cellules de la colonne T seront examinées.

j'ai mis une instruction msgbox qui affiche le nombre de cellules qui seront examinées. A toi de vérifier si c'est normal ou non.

Sub retranscription()
Dim i As Integer, j As Integer, Référence As Long
Set ws = Worksheets("2014")
Application.ScreenUpdating = False

ws.Range("A2:S" & Rows.Count).ClearContents
dlws = ws.Range("T" & Rows.Count).End(xlUp).Row
'*************************
MsgBox "j'ai trouvé " & dlws & " références dans la feuille 2014"
'*************************
dlwt = Worksheets("Total").Range("T" & Rows.Count).End(xlUp).Row
For i = 2 To dlws
    Référence = CLng(ws.Range("T" & i))
    j = 0
    On Error Resume Next
    j = Application.WorksheetFunction.Match(CLng(Référence), Sheets("Total").Range("T2:T" & dlwt), 0)
    On Error GoTo 0
    If j <> 0 Then Sheets("Total").Range("A" & j & ":S" & j).Copy ws.Range("A" & i)
Next i
Set ws = Nothing
End Sub

Bonjour,

Encore un tout grand merci pour ta peine et ton implication.

Le programme trouve les bonnes références. Ce que je comprends pas très bien c'est pourquoi, ayant trouvé les bonnes références, il ne se limite pas uniquement à celles qu'il a trouvées. En effet, le programme continue et "efface" tous les champs des colonnes A à S

qui se trouvent en-dessous de ce qu'il a mis à jour.

Je m'explique : s'il a mis à jour jusqu'au rang 24, il annule (il met des blancs) à partir du rang 25 tous les champs des colonnes A à S.

Ce n'est pas dramatique pour moi, car ce ne sont que des totaux des différentes colonnes. (totaux qui se trouvent au rang 250)

Je peux très facilement les reconstituer.

Encore une fois un tout grand merci

Bonsoir,

c'est l'instruction suivante qui provoque l'effacement. Comme elle se trouvait dans le code que tu as fourni, je ne l'ai pas enlevée.

il te suffit donc de l'enlever.

ws.Range("A2:S" & Rows.Count).ClearContents

Vous avez parfaitement raison.

Un tout grand merci encore pour votre aide, votre collaboration, votre patience.

Je vous souhaite un bon weekend ... ensoleillé si possible.

Merci.