Comparer 2 colonnes+copier la 4e dans la 3e

Résolu/Fermé

mouzila - 18 août 2010 à 11:51
mouzila - 19 août 2010 à 09:54

Bonjour,

Novice dans les macro et vb, je trouve des bribes de ce que je cherche à faire mais rencontres des difficultés et surtout suis dans l'impasse.
Je cherche à vérifier la présence d'un texte entre 2 colonnes dans des feuilles différentes + copier la valeur d'une 4e cellule dans la 3e.

Voici ci-dessous ce que je cherche à reproduire :

Pour chaque cellule de la colonne A (feuille1), si la valeur de la cellule est présente dans une cellule de la colonne A (feuille2), copier la valeur de la cellule A (feuille2) dans la celulle dans la colonne C (feuille1) qui se trouve sur la même ligne que la colonne A (feuille1)

J'ai tenté avec le code suivant (sur une même feuille pour commencer), et de nombreuses lignes reçoivent la mauvaise valeur :(

Pouvez-vous m'aider svp ?

Sub comparaison()
Dim VALEURA As String, VALEURB As String
'
For i = 1 To 45000
VALEURA = Range("C" & i).Value
For j = 1 To 26000
VALEURB = Range("I" & j).Value
'If VALEURA = VALEURB Then
If InStr(1, VALEURB, VALEURA, 1) Then
Sheets(1).Cells(j, "J").Copy
Sheets(1).Cells(i, "D").PasteSpecial Paste:=xlPasteValues
End If
Next j
Next i
End Sub

A voir également:

Comparer 2 colonnes+copier la 4e dans la 3e
Copier une vidéo youtube - Guide
Supercopier 2 - Télécharger - Gestion de fichiers
Fusionner 2 colonnes excel - Guide
2 comptes whatsapp - Guide
Word 2 colonnes - Guide

2 réponses

Réponse 1 / 2

Le Pingou Messages postés 12035 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 1 avril 2024 1 425
Modifié par Le Pingou le 18/08/2010 à 17:45

Bonjour,
Essayer cette procédure:

Sub CopierNomIdentique()  
Dim dlc As Long, nli As Long  
Dim cel As Range  
nli = Sheets(4).Cells(Columns(1).Cells.Count, 1).End(xlUp).Row  
For Each cel In Sheets(4).Range("a2:a" & nli)  
Set resu = Sheets(3).Range("A:A").Find(What:=cel.Value, lookat:=xlWhole)  
    If Not resu Is Nothing Then  
        Sheets(4).Cells(cel.Row, 1).Copy Destination:=Sheets(3).Cells(resu.Row, 3)  
    End If  
Next cel  
End Sub

Salutations.
Le Pingou

Réponse 2 / 2

mouzila
19 août 2010 à 09:54

super merci

Discussions similaires

Dessiner avec son clavier et avec des lettres

Table des matières dont les titres n'apparaissent pas..

Formule magique excel??????

programme qui n'affiche pas le mot secret

liste de noms par ordre alphabétique

Discussions similaires

Newsletters