Copier coller les donnees d'une colonne à rechercher

benjamin -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention - 17 déc. 2013 à 16:54

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

A voir également:

Copier coller les donnees d'une colonne à rechercher
Fuite données maif - Guide
Déplacer une colonne excel - Guide
Historique copier coller - Guide
Style d'écriture a copier coller - Guide
Copier coller pdf - Guide

3 réponses

Réponse 1 / 3

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Réponse 2 / 3

benjamin

Merci!! ça marche a merveille sans le if

Réponse 3 / 3

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Discussions similaires

dessin avec symbole clavier

dessin au clavier cannabis

Votre réponse

Discussions similaires