Copier coller les donnees d'une colonne à rechercher

benjamin -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour chers amis!
J'ai soif de votre assistance technique en VBA. J'y suis un apprenant.
J'ai un classeur ANN_LEG.xlsx
dans lequel je desire coller les donnes d'une colonne. voici la demarche: a partir d'un inputbox, j'ecri juste le titre de champ d'une colonne de la feuille tamp_cumul du classeur tampon. Par exemple PLF 2013, l'application recherche cette colonne dans la feuille tamp_cumul. s'il exite dans la premiere ligne un champ de titre nomme PLF 2013, toute la colonne est recopiée et collée dans la feuille cumul du classeur ANN_LEG.xlsx.
Tant que le texte n'existe pas dans la ligne des titres de champs, un nouveau inputbox apparait et demande de renseigner un nouveau titre de champs.

Voici ce que j'ai fais avec d'autres assistances, ca marche pas car je suis confronté à un probleme de boucle folle(a chaque saisi un nouveau inputbox apparait et demande de renseigner un nouveau titre de champs comme si le texte n'existait pas dans la liste titre de champs).

Aidez moi, s'il vous plait!

Sub Ob_Cumul()

Dim rngTrouve As Range

ip = InputBox("Veuillez renseigner un titre de champs! " & Chr(10) & "Par Exemple : PLF 2013", "ANNEE 1!!!")
Set rngTrouve=Workbooks("Tampon.xlsx").Worksheets("tamp_cumul").Rows(1).Cells.Find(ip, lookat:=xlWhole)

if  rngTrouve Is Nothing  Then
ip = InputBox(" Titre de champs inexistant dans le fichier source! " & Chr(10) & "Par Exemple : PLF 2013", "ANNEE!!)
else
col=rngTrouve.columns
workbooks("Tampon.xlsx").Worksheets("tamp_cumul").columns(col).copy workbooks("ANN_LEG.xlsx").worksheets("cumul").range("BC1")
end if
end sub

3 réponses

  1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    Sub Ob_Cumul()
    Dim rngTrouve As Range
    Do While rngTrouve Is Nothing
    ip = InputBox("Veuillez renseigner un titre de champs! " & Chr(10) & "Par Exemple : PLF 2013", "ANNEE 1!!!")
    'Set rngTrouve = Workbooks("Tampon.xlsx").Worksheets("tamp_cumul").Rows(1).Cells.Find(ip, lookat:=xlWhole)
    If ip <> "" Then
    Set rngTrouve = Workbooks("Tampon.xlsx").Worksheets("tamp_cumul").Rows(1).Cells.Find(ip, lookat:=xlWhole)
    Else

    End If
    Loop
    'recuperation lettre(s) colonne
    col = Split(Range(rngTrouve.Address).Address, "$")(1)
    Workbooks("Tampon.xlsx").Worksheets("tamp_cumul").Columns(col).Copy Workbooks("ANN_LEG.xlsx").Worksheets("cumul").Range("BC1")
    End Sub
    0
  2. benjamin
     
    Merci!! ça marche a merveille sans le if
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    mieux avec ceci

    Sub Ob_Cumul()
    Dim rngTrouve As Range
    Do While rngTrouve Is Nothing
    ip = InputBox("Veuillez renseigner un titre de champs! " & Chr(10) & "Par Exemple : PLF 2013", "ANNEE 1!!!")
    'teste si fermeture par croix ou annuler ou ok vide
    If ip <> "" Then
    Set rngTrouve = Workbooks("Tampon.xlsx").Worksheets("tamp_cumul").Rows(1).Cells.Find(ip, lookat:=xlWhole)
    'recuperation lettre(s) colonne
    col = Split(Range(rngTrouve.Address).Address, "$")(1)
    Workbooks("Tampon.xlsx").Worksheets("tamp_cumul").Columns(col).Copy Workbooks("ANN_LEG.xlsx").Worksheets("cumul").Range("BC1")
    End If
    Loop
    End Sub
    0