Plage Dynamique

Bonjour à tous,

Je développe actuellement un outil interne pour mon entreprise. Je cherche actuellement à charger des données dans mon fichier excel à partir d'un autre. Pour cela, je fais une macro, qui ouvre un nouveau fichier, pour prendre ses données.

Je précise que je fais une comparaison de la première ligne de chaque colonne avec celle de ma feuille destinataire, afin de pouvoir copier colonne par colonne. Le but de cette comparaison étant de ne pas être obligé d'ordonner les filtres sur le logiciel qui contient les données à l'origine.

Mais je ne parviens pas à faire de range dynamique lors de ma copie. J'ai déjà essayé de contourner le problème en modifiant les valeurs des cellules une par une dans une boucle for, mais ceci n'est pas du tout optimisé quand notre fichier source contient plusieurs dizaine de milliers de cellules...

Je vous fourni le code de ma macro :

Private Sub CommandButton1_Click()

    Dim va As String
    Dim vb As String
    Dim val As Long

    'Ouverture d'une fenêtre exploreur pour charger l'input SNOW
    FileToOpen = Application.GetOpenFilename("Fichiers Excel(*.xls;*.xlsx), *.xls;*.xlsx", , "Choisir le fichier à ouvrir")

    'Si l'opération est annulée
    If FileToOpen = False Then
        MsgBox "Operation annulée", vbExclamation
    Exit Sub
    End If

    'Suppresion du contenu de l'onglet BD_Extract_SNOW
    ClearBDExtract

    Set wsa = Worksheets("BD_Extract_SNOW")

    Workbooks.Open FileToOpen
        Sheets(1).Select
        Set wsb = Worksheets(1)
        indicateurL = wsb.Range("A1048576").End(xlUp).Row
        indicateurC = wsb.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

        For i = 1 To indicateurC
            vb = wsb.Cells(1, i)
            For j = 1 To indicateurC
                va = wsa.Cells(1, j)
                If vb = va Then
                    wsb.Range(Cells(1, i), Cells(indicateurL, i)).Select         'Range dynamique qui ne fonctionne pas...
                    'For k = 1 To indicateurL
                        'wsb.Cells(k, i).Copy wsa.Cells(k, j)
                    'Next k
                    Exit For
                End If
            Next j
        Next i

    Set wsa = Nothing
    Set wsb = Nothing

End Sub

Public Function ClearBDExtract()

    Worksheets("BD_Extract_SNOW").Range("A2:BZ5001").ClearContents

End Function

Bonjour Antoine_cathd

D'abord réalise une mini-base de données (une dizaine de lignes) pour le classeur donneur.

Puis teste à partir du classeur receveur la récupération de ces données.

Compte tenu du va et vient entre les deux classeurs (lecture/écriture). Il convient de bien préciser sur quel classeur actif le programme se déroule.

Lorsque tu auras créer ta mini-base et tester. Si cela bloque. Poste les fichiers sur le site.

A suivre...

Bonjour X Cellus,

Merci pour ta réponse rapide. Ma feuille de réception sont déjà créée. J'ai pu régler mon premier soucis de copie en contournant la définition de plage dynamique en utilisant tout simplement la propiriété "Columns(numéroColonne)".

Ma macro fonctionne donc. Le problème qui se pose maintenant est que je vais avoir besoin d'une deuxième macro qui implémente les données à la suite des données déjà enregistrées. Je vais donc avoir besoin de définir des plages dynanimes (des "range(cells(1,i), cells(1,j)).

Si quelqu'un a donc une solution pour faire des range dynamique, je n'ai toujours pas trouvé...

Je rajoute le code de ma macro (maintenant) fonctionnelle pour mieux exposer le problème :

Private Sub CommandButton1_Click()

    Dim va As String
    Dim vb As String
    Dim val As Long

    'Ouverture d'une fenêtre exploreur pour charger l'input SNOW
    FileToOpen = Application.GetOpenFilename("Fichiers Excel(*.xls;*.xlsx), *.xls;*.xlsx", , "Choisir le fichier à ouvrir")     'contient le lien absolu du fichier à ouvrir

    'Si l'opération est annulée on termine l'action
    If FileToOpen = False Then
        MsgBox "Operation annulée", vbExclamation
    Exit Sub
    End If

    'Suppresion du contenu de l'onglet BD_Extract_SNOW
    ClearBDExtract

    Set wsa = Worksheets("BD_Extract_SNOW")     'création d'une variable qui enregistre la feuille de destination

    Workbooks.Open FileToOpen       'ouverture du fichier source
        Sheets(1).Select        'Selection de la feuille contenant les données (la seule feuille du fichier)
        Set wsb = Worksheets(1)     'création d'une variable qui enregistre la feuille source

        indicateurL = wsb.Range("A1048576").End(xlUp).Row       'recherche de la dernière ligne non-vide
        indicateurC = wsb.Cells(1, Cells.Columns.Count).End(xlToLeft).Column        'recherche de la dernière colonne non-vide

        'Début de l'algorithme de comparaison de nom de colonne
        For i = 1 To indicateurC        'Parcours des noms de colonnes du fichier source
            vb = wsb.Cells(1, i)

            For j = 1 To indicateurC        'Parcours des noms de colonnes du fichier de destination
                va = wsa.Cells(1, j)

                If vb = va Then         'Test noms identiques / si oui : copie de la colonne
                    wsb.Columns(i).Copy Destination:=wsa.Columns(j)         'commande de copie de la colonne du fichier source vers le fichier de destination
                    Exit For
                End If

            Next j

        Next i

        ActiveWorkbook.Close False      'fermeture du fichier source

    Set wsa = Nothing       'désalocation
    Set wsb = Nothing       'désalocation

End Sub

Public Function ClearBDExtract()

    Worksheets("BD_Extract_SNOW").Range("A2:BZ5001").ClearContents      'Suppression du contenu de la feuille de BD

End Function