XL 2019 recherche ou aller sur

[MOmichel]

bonjour
J'ai un fichier avec deux feuilles (source) et (Extract achat)

je voudrais de ma cellule active dans "extract achat" aller me postionnner dans fichier "source--- colonne( "d" ) sur la cellule contenant cette valeur (qui est unique)

Pourriez-vous me proposer un code

 

[Lolote83]

Salut MOMichel,
Sans fichier, voici ce que j'ai compris.
@+ Lolote83

 

[MOmichel]

Bonjour

je vais te mettre mon fichier en partage

ce que je voudrais faire (dans module 4) :
une mise à jour du fichier "source " par le fichier EXTRACT ACHAT "qui est renseigné par une tierce personne
par l'indexe qui est une numerotation unique et identique dans " EXTRACT ACHAT" (colonne BE" ) et "SOURCE" (colonne M" )
la mise a jour des cellules
Historique des commentaires " EXTRACT ACHAT" --> cause de l'alerte "SOURCE"
Gac " EXTRACT ACHAT" --> acheteur "SOURCE"
j'espere etre assez explicite
par avance merci

 

[Lolote83]

Bonjour,
Je viens de regarder votre fichier mais franchement, je ne comprends pas ce que vous souhaitez faire.
Besoin de plus d'explications claires.
Merci
@+ Lolote83

 

[MOmichel]

bonjour
je veux mettre à jour avec les informations de fichier "EXTRACT ACHAT" dans fichier source "SOURCE" c'est a dire transférer les informations des cellules colonne " Historique des commentaires " et " Gac " du fichier EXTRACT ACHAT vers le fichier "source" en respectant la reference / designation/index-- je suis assez clair ?

 

[MOmichel]

voici un schema de ce que je veux faire

 

[Lolote83]

Salut MOMichel,
D'après ce que j'ai compris, voici le code.
A copier dans un nouveau module.
Les données de l'onglet Extract Achat de la colonne E (Gac) et BA (Historique) seront inscrites dans l'onglet Source en colonne H (Gac) et I (Historique)

Sub MAJ_Source()
    Application.ScreenUpdating = False
    With Sheets("Extract Achat")                                            'On travaille sur l'onglet Extract Achat
        xDerLig = .Range("BE1000").End(xlUp).Row                            'On récupère la denière ligne saisie
        For F = 1 To xDerLig                                                'Boucle de la ligne 1 à dernière ligne
            xIdx = .Range("BE" & F + 7)                                     'On affecte à xIdx l'index (Colonne BE)
            xGac = .Range("E" & F + 7)                                      'On affecte à xGac le GAC (Colonne E)
            xHis = .Range("BA" & F + 7)                                     'On affecte à xHis l'historique (Colonne BA)
            With Sheets("Source")                                           'On travaille sur l'onglet Source
                On Error GoTo PasTrouve                                     'Si on ne trouve pas de correspondance, on va à PasTrouve:
                xResult = Application.Match(xIdx, .Range("M2:M1000"), 0)    'On affecte à xResult
                If xResult > 0 Then                                         'Si résultat positif
                    .Range("H" & 1 + xResult) = xGac                        'On sincrit en colonne H le résultat de xGac
                    .Range("I" & 1 + xResult) = xHis                        'On inscrit en colonne I le résultat de xHis
                End If                                                      'Fin Si
            End With                                                        'Fin travail sur onglet Source
PasTrouve:                                                                  'Etiquette PasTrouve
        Next F                                                              'Fin boucle
    End With                                                                'Fin travail sur onglet Extract Achat
    Application.ScreenUpdating = True
End Sub

En espérant avoir bien compris la demande
@+ Lolote83

 

[MOmichel]

Bonjour
Pourriez-vous m'indiquer comment écrire les variables ?
cordialement

 

[Lolote83]

Re bonjour,
Je ne suis pas sûr d'avoir bien compris la question.
Mais avec ce code ou sont renseignées les variables en début

Sub MAJ_Source()
    Application.ScreenUpdating = False
    
    '------------------------------------------
    '                  Définition des variables
    '------------------------------------------
    Dim xIdx As Integer                                                     'Définition variable Index
    Dim xGac As String                                                      'Définition variable Gac
    Dim xHis As String                                                      'Définition variable Historique
    Dim xDerLig As Integer                                                  'Définition variable Dernière ligne
    Dim F As Integer                                                        'Définition variable F (boucle)
    Dim xResult As Integer                                                  'Définition variable xResult
    '------------------------------------------
    '                                     Suite
    '------------------------------------------
    With Sheets("Extract Achat")                                            'On travaille sur l'onglet Extract Achat
        xDerLig = .Range("BE1000").End(xlUp).Row                            'On récupère la denière ligne saisie
        For F = 1 To xDerLig                                                'Boucle de la ligne 1 à dernière ligne
            xIdx = .Range("BE" & F + 7)                                     'On affecte à xIdx l'index (Colonne BE)
            xGac = .Range("E" & F + 7)                                      'On affecte à xGac le GAC (Colonne E)
            xHis = .Range("BA" & F + 7)                                     'On affecte à xHis l'historique (Colonne BA)
            With Sheets("Source")                                           'On travaille sur l'onglet Source
                On Error GoTo PasTrouve                                     'Si on ne trouve pas de correspondance, on va à PasTrouve:
                xResult = Application.Match(xIdx, .Range("M2:M1000"), 0)    'On affecte à xResult
                If xResult > 0 Then                                         'Si résultat positif
                    .Range("H" & 1 + xResult) = xGac                        'On sincrit en colonne H le résultat de xGac
                    .Range("I" & 1 + xResult) = xHis                        'On inscrit en colonne I le résultat de xHis
                End If                                                      'Fin Si
            End With                                                        'Fin travail sur onglet Source
PasTrouve:                                                                  'Etiquette PasTrouve
        Next F                                                              'Fin boucle
    End With                                                                'Fin travail sur onglet Extract Achat
    Application.ScreenUpdating = True
End Sub

@+ Lolote83

 

[MOmichel]

bonjour et milles merci

la procédure fonctionne bien mais ne s'arrète pas lorsque que dans "Extract achat" l'index est vide ou égale à zéro , pourriez-vous mettre cette condition dans le code

 

[Lolote83]

Bonsoir,
Je n'ai pas mis cette clause car la fin est déterminée par la dernière ligne saisie de la colonne BE.
Dans votre fichier joint, la dernière donnée est en ligne 108. Donc effectivement entre les lignes 18 et 108, c'est du vide mais cela s’arrêtera à la ligne 108.
Donc, en prenant en compte votre remarque, voici le code

Sub MAJ_Source()
    Application.ScreenUpdating = False
    
    '------------------------------------------
    '                  Définition des variables
    '------------------------------------------
    Dim xIdx As Integer                                                     'Définition variable Index
    Dim xGac As String                                                      'Définition variable Gac
    Dim xHis As String                                                      'Définition variable Historique
    Dim xDerLig As Integer                                                  'Définition variable Dernière ligne
    Dim F As Integer                                                        'Définition variable F (boucle)
    Dim xResult As Integer                                                  'Définition variable xResult
    '------------------------------------------
    '                                     Suite
    '------------------------------------------
    With Sheets("Extract Achat")                                            'On travaille sur l'onglet Extract Achat
        xDerLig = .Range("BE1000").End(xlUp).Row                            'On récupère la denière ligne saisie
        For F = 1 To xDerLig                                                'Boucle de la ligne 1 à dernière ligne
            xIdx = .Range("BE" & F + 7)                                     'On affecte à xIdx l'index (Colonne BE)
            xGac = .Range("E" & F + 7)                                      'On affecte à xGac le GAC (Colonne E)
            xHis = .Range("BA" & F + 7)                                     'On affecte à xHis l'historique (Colonne BA)
            If xIdx <> 0 Then
                With Sheets("Source")                                           'On travaille sur l'onglet Source
                    On Error GoTo PasTrouve                                     'Si on ne trouve pas de correspondance, on va à PasTrouve:
                    xResult = Application.Match(xIdx, .Range("M2:M1000"), 0)    'On affecte à xResult
                    If xResult > 0 Then                                         'Si résultat positif
                        .Range("H" & 1 + xResult) = xGac                        'On sincrit en colonne H le résultat de xGac
                        .Range("I" & 1 + xResult) = xHis                        'On inscrit en colonne I le résultat de xHis
                    End If                                                      'Fin Si
                End With                                                        'Fin travail sur onglet Source
            End If
PasTrouve:                                                                  'Etiquette PasTrouve
        Next F                                                              'Fin boucle
    End With                                                                'Fin travail sur onglet Extract Achat
    MsgBox "Traitement terminé", vbInformation, "DONNES DANS SOURCE"
    Application.ScreenUpdating = True
End Sub

@+ Lolote83