Macro VBA selection et remplacement

Bonjour,

Je débute en VBA et j'aimerais votre aide sur un code.

Je cherche a selectionner les valeurs de la colonne U de fichier FRS qui est mon fichier actif, puis de regarder si cette valeur est présente dans le fichier MD, colonne 2, si oui, prendre la valeur de la ligne ou il se trouve et a la colonne F, puis coller cette valeur dans la colonne AG de la ligne de base de mon fichier actif.

Merci d'avance

Sub Macro2()

'déclaration
Dim valueMD, valueFRS, rowMD, rowFRS, lastRowMD, lastRowFRS As Long
Dim valA As String

Dim wsMD, wsFRS As Worksheet

Workbooks("MD.xlsm").Activate
Set wsMD = ActiveWorkbook.Sheets("Upage WS-2.2")
MsgBox ActiveWorkbook.Name
lastRowMD = wsMD.Cells(Rows.Count, 1).End(xlUp).Row

ThisWorkbook.Activate
Set wsFRS = ActiveWorkbook.Sheets("Product")
MsgBox ActiveWorkbook.Name
lastRowFRS = wsFRS.Cells(Rows.Count, 1).End(xlUp).Row

'boucles
For rowFRS = 1 To lastRowFRS
valueFRS = wsFRS.Cells(rowFRS, 21).Value 'col U : 21
For rowMD = 1 To lastRowMD
valueMD = wsMD.Cells(rowMD, 2).Value 'col B : 2

If valueMD = valueFRS Then
valA = wsMD.Cells(rowDM, 9).Value
wsFRS.Cells(rowFRS, 33).Value = valA 'col AF et AR : 32 44

End If
Next
Next

End Sub

Pour commencer, prendre les bonnes habitudes. Lorsque vous écrivez :

    Dim wsMD, wsFRS As Worksheet

wsMD est du type Variant et wsFRS du type Worksheet. Vous pouvez le vérifier en ajoutant :

1    wsMD = "toto"
2    wsFRS = "tata"

Vous aurez une erreur sur la ligne 2, mais pas sur la ligne 1 où wsMD aura pris la valeur "toto".
Pour déclarer 2 feuilles, il faut donc écrire

Dim wsMD As Worksheet, wsFRS As Worksheet

Idem pour votre série de Long.

Ensuite, vous avez un éditeur de code dans les outils (icone </>), il vous permet de conserver l'indentation, ce qui facilite la lecture d'un code.

Question : votre macro se trouve dans le classeur MD.xlsm ?

Merci, j'ai modifié, ma macro se trouve dans mon doc FRS.

Sub Macro1()

'déclaration
Dim valueDM As Long, valueFRS As Long, rowDM As Long, rowFRS As Long, lastRowDM As Long, lastRowFRS As Long
Dim valA As String

Dim wsMD As Worksheet, wsFRS As Worksheet

Workbooks("Copie de FRANCE MasterData Produits.xlsm").Activate
Set wsDM = ActiveWorkbook.Sheets("ACTIFS")
MsgBox ActiveWorkbook.Name
lastRowDM = wsDM.Cells(Rows.Count, 1).End(xlUp).Row

ThisWorkbook.Activate
Set wsFRS = ActiveWorkbook.Sheets("Product")
MsgBox ActiveWorkbook.Name
lastRowFRS = wsFRS.Cells(Rows.Count, 1).End(xlUp).Row

'boucles
For rowFRS = 1 To lastRowFRS
    valueFRS = wsFRS.Cells(rowFRS, 21).Value 'col U : 21
    For rowDM = 1 To lastRowDM
        valueDM = wsDM.Cells(rowDM, 2).Value 'col B : 2

        If valueDM = valueFRS Then
            valA = wsDM.Cells(rowDM, 44).Value
            wsFRS.Cells(rowFRS, 32).Value = valA 'col AF et AR : 32 44

        End If
    Next
Next

End Sub

Je n'ai fait que modifier un peu votre code pour qu'il fonctionne et que vous puissiez voir les pb.
Ce code peut être optimisé, il est possible de faire beaucoup plus simple (le va-et-vient entre les classeurs n'est pas nécessaire).

J'ai tout mis dans le dossier d:\PB\ chez moi, vous changerez le path.

Option Explicit

Sub Macro2()
    'déclaration
    Dim valueDM As Long, valueFRS As Long, rowDM As Long, rowFRS As Long, lastRowDM As Long, lastRowFRS As Long
    Dim valA As String, fichier As String

    Dim wsDM As Worksheet, wsFRS As Worksheet, wBook As Workbook

    fichier = "d:\PB\Copie de FRANCE MasterData Produits.xlsm"
    Set wBook = Workbooks.Open(fichier)
    wBook.Activate
    Set wsDM = wBook.Sheets("ACTIFS")
    lastRowDM = wsDM.Cells(Rows.Count, 1).End(xlUp).Row
    ThisWorkbook.Activate

    Set wsFRS = ActiveWorkbook.Sheets("Product")
    lastRowFRS = wsFRS.Cells(Rows.Count, 1).End(xlUp).Row

    'boucles
    For rowFRS = 1 To lastRowFRS
        valueFRS = wsFRS.Cells(rowFRS, 21).Value 'col U : 21
        For rowDM = 1 To lastRowDM
            valueDM = wsDM.Cells(rowDM, 2).Value 'col B : 2
             If valueDM = valueFRS Then
                valA = wsDM.Cells(rowDM, 44).Value
                wsFRS.Cells(rowFRS, 32).Value = valA 'col AF et AR : 32 44
            End If
        Next rowDM
    Next rowFRS
End Sub
Rechercher des sujets similaires à "macro vba selection remplacement"