Récupérer des colonnes d'un fichier source selon un modèle précis

Bonjour à tous,

Je vous fais part d'un blocage que j'ai depuis plusieurs temps maintenant. Je débute en VBA et mon projet est le suivant

A.Je récupère des données d'un logiciel (fichier Conf )

B. Je souhaite automatiser la modification du fichier. Cette modification dépend d'un critère => Le modèle du client

. 1. En ce sens, au sein du fichier Template vous trouverez en colonne 2 la liste des colonnes du Client 1

2. En colonne 1 l'équivalence de cette colonne au sein du fichier Conf

. 3. En colonne 3 certaines colonnes ne sont pas dans le fichier source mais le client les veut avec une valeur fixe

Prenons l'exemple dans le fichier Template nous avons en colonne 2 la première ligne qui est "symbol"

Donc mon programme doit chercher la colonne "symbol" dans mon fichier source (Conf) si il trouve alors c'est super il copie colle la colonne dans une feuille vierge ( pour tester j'ai dis dans le code que je voulais la feuille 2 de mon fichier template). Puis la colonne suivante c'est "Account" ..pour le coup (Deuxième ligne de la colonne si on omet l'en-tête). Cette colonne n'a pas d'équivalence dans le fichier source du coup on va la créer et ça sera donc la deuxième colonne de mon résultat avec en en-tête "account" et en valeur dans la colonne "Z12345" pour toute les cellules (je m'arrêterai à la dernière ligne non vide de la colonne symbol). Enfin par exemple, la 4ième ligne de ma recherche est Quantité...elle existe dans le fichier Conf mais sous le nom de Qty.

Sub temp()
Dim Template As Worksheet, Quod As Worksheet, rslt As Worksheet

Dim cellule As Range, C As Range, C2 As Range
Dim MatchingCol As Range
Dim ColTemp As Range, plageTemp As Range, Equiv As Range

Dim add As Range, valFixe As Range, i As Integer
Dim quodHeader As Range
Dim plageHeader As Range

    'Workbooks.Open "/Users/XLSM75/Downloads/Template.xlsm"
    Set Template = Workbooks("Template.xlsm").Worksheets(1)
    Set ColTemp = Template.Cells.Find(what:="CUSTO1")
    Set plageTemp = Range(Cells(2, ColTemp.Column), Cells(Cells.End(xlDown).Row, ColTemp.Column))
    Set rslt = Workbooks("Template.xlsm").Worksheets(2)

    Workbooks.Open "/Users/XSLM75/Downloads/Conf.xls"

    With Conf
        Set Quod = Workbooks("Conf.xls").Worksheets(1)
        Set quodHeader = Quod.Cells.Find(what:="Give-up Broker")
        Set plageHeader = Range(Cells(quodHeader.Row, 1), Cells(quodHeader.Row, Cells.End(xlToRight).Column))
    End With

    Application.ScreenUpdating = False

    i = 1

With Template

    For Each cellule In plageTemp

            With Conf
            Set C = plageHeader.Find(cellule, , xlValues)
            Set MatchingCol = Range(Cells(2, C.Column), Cells(C.End(xlDown).Row, C.Column))
        End With

            If Not C Is Nothing Then

                MatchingCol.Select
                Selection.Copy Destination:=rslt.Columns(i)

                Else
                With Template
                    Set Equiv = cellule.Offset(0, -1)
                End With

                Set C2 = plageHeader.Find(Equiv, , xlValues, xlWhole)
                Set MatchingCol = Range(Cells(2, C2.Column), Cells(Cells.End(xlDown).Row, C2.Column))

                    If Not C2 Is Nothing Then

                    MatchingCol.Select
                    Selection.Copy Destination:=rslt.Columns(i)

                    Else

                    Set valFixe = cellule.Resize(, 2)
                    valFixe.Select
                    Selection.Copy

                    rslt.Columns(i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

                    End If
            End If

    i = i + 1
   Next cellule
End With

Set C = Nothing: Set C2 = Nothing: Set Template = Nothing: Set Quod = Nothing

Workbooks("Conf").Close

Application.ScreenUpdating = True

End Sub

Mon problème est qu'au niveau du MatingCol j'ai ce message alors qu'à mon sens tout est carré.

De plus pour les copie/colle je suis obligé de passé par la phase sélect sinon rien ne se passe.

Si des experts du range, des pros du matching & du find peuvent m'aider ça serait génial !!

Merci l'équipe

Bonjour XLSM75 et le forum,

2. En colonne 1 l'équivalence de cette colonne au sein du fichier Conf

Là je n'ai pas trouvé ou alors serais-je mal réveillé?

Bonjour Fcyspm30,

la colonne 1 (ou A) du fichier Template correspond à des en-têtes présentes dans le fichier Conf. Désolé si je me suis mal exprimé. La colonne B est le template du client et en colonne C les valeurs fixes.

Merci

re

J'étais mal réveillé car je n'avais pas bien compris l'explication.

Re

Ceci dit vous faites référence à feuil2 que je ne vois pas non plus. Dans le dossier template il y a Sheet1 et Feuil1. Il y a peut-être un problème de ce côté là. Je ne suis pas spécialiste en VBA mais si ma réflexion peut vous éclairer j'en serais très content.

Bonjour,

Merci de votre réponse, en effet j'ai partagé le mauvais fichier et je suis désolé. (Lorsque j'apprends je fais plusieurs copies de mon fichier pour faire différents test...et je confonds les fichiers...)

Mais dans ce bout de code j'ai créé une variable "rslt" worksheet qui correspond à la sheet2 du workbook. Parfois j'ai le message dont j'ai fait une capture d'écran..parfois j'ai une colonne en résultat. Je ne comprends vraiment pas où je me trompe.

Sub temp()
Dim Template As Worksheet, Quod As Worksheet, rslt As Worksheet

Dim cellule As Range, C As Range, C2 As Range
Dim MatchingCol As Range
Dim ColTemp As Range, plageTemp As Range, Equiv As Range

Dim add As Range, valFixe As Range, i As Integer
Dim quodHeader As Range
Dim plageHeader As Range

    'Workbooks.Open "/Users/XLSM75/Downloads/Template.xlsm"
    Set Template = Workbooks("Template.xlsm").Worksheets(1)
    Set ColTemp = Template.Cells.Find(what:="CUSTO1")
    Set plageTemp = Range(Cells(2, ColTemp.Column), Cells(Cells.End(xlDown).Row, ColTemp.Column))
    Set rslt = Workbooks("Template.xlsm").Worksheets(2)

    Workbooks.Open "/Users/XLSM75/Downloads/Conf.xls"

    With Confo
        Set Quod = Workbooks("Conf.xls").Worksheets(1)
        Set quodHeader = Quod.Cells.Find(what:="Give-up Broker")
        Set plageHeader = Range(Cells(quodHeader.Row, 1), Cells(quodHeader.Row, Cells.End(xlToRight).Column))
    End With

    Application.ScreenUpdating = False

    i = 1

With Template

    For Each cellule In plageTemp

        With Conf
            Set C = plageHeader.Find(cellule, , xlValues)
            Set MatchingCol = Range(Cells(2, C.Column), Cells(C.End(xlDown).Row, C.Column))
        End With

            If Not C Is Nothing Then

                MatchingCol.Select
                Selection.Copy Destination:=rslt.Columns(i)

                Else
                With Template
                    Set Equiv = cellule.Offset(0, -1)
                End With

                Set C2 = plageHeader.Find(Equiv, , xlValues, xlWhole)
                Set MatchingCol = Range(Cells(2, C2.Column), Cells(C2.End(xlDown).Row, C2.Column))

                    If Not C2 Is Nothing Then

                    MatchingCol.Select
                    Selection.Copy Destination:=rslt.Columns(i)

                    Else

                    Set valFixe = cellule.Resize(, 2)
                    valFixe.Select
                    Selection.Copy
                    'Destination:=rslt.Columns(i)

                    Worksheets("Feuil1").Column(i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

                    End If
            End If

    i = i + 1
   Next cellule
End With

Set C = Nothing: Set C2 = Nothing: Set Template = Nothing: Set Quod = Nothing

Workbooks("Conf.xls").Close

Application.ScreenUpdating = True

End Sub