Boucle tant que et fin de fichier et rangement

bonjour je sollicite votre aide car

je souhaiterais faire une boucle tant que fin de fichier sur la ligne A6

prendre la valeur de la première cellule la rechercher dans la ligne 8 et et des qu'on a trouver la valeur dans la ligne 8 coller la valeur en 7 au dessus de la même ville

exemple Allenes Les Marais (situe en a6), je le trouve en h8 donc je colle la valeur de a6(Allenes Les Marais) en h7

et faire ca jusque la fin de fichier de la ligne 6

a savoir qu'il y a des villes jusqu'en "ch8" donc faire une fin de fichier également sur la ligne 8

j'espere avoir été clair et je vous remercie de votre aide . ca fait 5 ans que j'ai plus développé en vba , je vais recommencer par les bases une fois ce travail fini

merci de votre aide

Bonjour,

j'espere avoir été clair Pas du tout, le fichier fourni ne correspond à rien de ce que vous décrivez. Redéposez un fichier qui corresponde bien à vos descriptions avec quelques exemples de résultats recherchés.

Cdlt

bonjour

sélectionner la case ("a6")

tant que je ne suis pas arrivé à la fin des données de la ligne 6

recuperer la valeur de la cellule ("a6")

faire une recherche de la valeur ("A6") dans les celulles ("H8") a fin de ligne

des que j'ai trouve la meme valeur

faire activecell.offset(-1,0).select

coller la valeur

et recommencer avec la cellule ("b6") jusque la fin de la ligne

Comprends pas la logique, désolé.

Quel est l'intérêt de faire une recherche dans la ligne 8.

Si le but final est de recopier les valeurs de la ligne 6, autant recopier directement les valeurs de la ligne 6 en H8 jusqu'à R8, non!

non c'est pas possible car derrière j'ai des tableaux croises dynamique

exemple de mon code

Sheets("extract").Select
Range("a6").Select
rechercher_ville = ActiveCell.Address
nom_rech_ville = ActiveCell.Value

dern_col = Cells(6, Cells.Columns.Count).End(xlToLeft).Column ( la ca me retourne 10 c'est bien le nombre de cellule non vide, j'aurai prefere obtenir la lettre)
While rechercher_ville <> dern_col

Range(rechercher_ville).Select
ActiveCell.Offset(0, 1).Select
rechercher_ville = ActiveCell.Address
Wend

Si vous voulez obtenir la lettre de la dernière colonne:

    Der_Col = Split(Cells(6, "A").End(xlToRight).Address, "$")(1)

merci

voila comment j'ai fait

Sub rech_ville()

Sheets("extract").Select

Range("a6").Select

adresse_ville = ActiveCell.Address
Valeur_Cherchee = ActiveCell.Value

DernCol = Range("A6").End(xlToRight).Column

ActiveCell.Offset(0, DernCol).Select

adrese_der_colonne = ActiveCell.Address
While adresse_ville <> adrese_der_colonne

Set PlageDeRecherche = ActiveSheet.Rows(8)

'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then

AdresseTrouvee = Valeur_Cherchee

Else

AdresseTrouvee = Trouve.Address
End If

Range(AdresseTrouvee).Select
ActiveCell.Offset(-1, 0).Select
ActiveCell.Value = Valeur_Cherchee

'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

Range(adresse_ville).Select
ActiveCell.Offset(0, 1).Select
adresse_ville = ActiveCell.Address
Valeur_Cherchee = ActiveCell.Value

Wend

Essayez ceci

Sub Rech_Ville()
    Dim f1 As Worksheet
    Dim i As Long, DernCol As Long
    Dim Valeur_Cherchee As String, AdresseTrouvee As String
    Dim Trouve As Object

    Application.ScreenUpdating = False
    Set f1 = Sheets("extract")
    DernCol = f1.Range("A6").End(xlToRight).Column
    Set PlageDeRecherche = Range(f1.Cells(8, "A"), f1.Cells(8, f1.Range("A8").End(xlToRight).Column))
    For i = 1 To DernCol
        Valeur_Cherchee = f1.Cells(6, i)
        Set Trouve = PlageDeRecherche.Cells.Find(Valeur_Cherchee, LookAt:=xlWhole) 'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
        'traitement de l'erreur possible : Si on ne trouve rien :
        On Error Resume Next
        If Not Trouve Is Nothing Then
            Cells(7, Trouve.Column) = Valeur_Cherchee
            On Error GoTo 0
        End If
    Next i
    'Vidage de la mémoire
    Set Trouve = Nothing
    Set f1 = Nothing
End Sub

Cdlt

Merci