Mise à jour fichier 1 avec un fichier 2

Bonjour,

J'ai besoin de mettre à jour une "base1" avec les données de la base 2 qui contient des données complémentaires (voir fichier joint ).

La base initiale fait 5000 lignes alors que la mise à jour 1400 d'où ma recherche d'automatisation.

question 1 : est-ce qu'une macro peut répondre à mon besoin ? si oui, laquelle

Question 2 : existe t'il une autre solution logiciel "simple" à mettre en œuvre ? Type Microsoft Query (à tout hasard) ?

Merci pour votre retour.

Bon week-end

Watson

8exemple.xlsx (12.71 Ko)

Bonjour

Pour une réponse adaptée, indique ta version Excel dans ton profil

Bonjour,

Je ne sais pas si la version d'Excel changera quelque chose mais tu peux essayer ça :

Sub MàJ_B2_to_B1()
Dim FichierBase1 As Workbook
Dim FichierBase2 As Workbook
Dim FeuilleDonnéesBase1 As Worksheet
Dim FeuilleDonnéesBase2 As Worksheet
Dim I, J As Integer

Set FichierBase1 = Workbooks("base1.xlsm")
Set FichierBase2 = Workbooks("base2.xlsx")

Set FeuilleDonnéesBase1 = FichierBase1.Worksheets("base1")
Set FeuilleDonnéesBase2 = FichierBase2.Worksheets("base2")

For I = 1 To FeuilleDonnéesBase1.Range("A65535").End(xlUp).Row
    For J = 1 To FeuilleDonnéesBase2.Range("A65535").End(xlUp).Row
        If FeuilleDonnéesBase1.Cells(I, "A") = FeuilleDonnéesBase2.Cells(J, "A") Then
            FeuilleDonnéesBase1.Cells(I, "G") = FeuilleDonnéesBase2.Cells(J, "G")
        End If
    Next
Next

Set FeuilleDonnéesBase1 = Nothing
Set FeuilleDonnéesBase2 = Nothing
Set FichierBase1 = Nothing
Set FichierBase2 = Nothing

End Sub

A mettre dans le fichier Base1 et l'enregistré en XLSM

Les deux fichiers doivent être ouvert lors du lancement de la procédure.

Cordialement,

RE

Je ne sais pas si la version d'Excel changera quelque chose ...

Si, surtout quand Watson2Paris dit "Type Microsoft Query" sans que l'on sache s'il s'agit de MS Query ou PowerQuery...

Bonjour Chris,

Peux tu éclairer ma lanterne et m'expliquer ce qu'est MS Query ?

RE

MSQUERY est intégré à Excel depuis la nuit des temps

Pas trop convivial mais permet de croiser des tables de données ou de faire des union de tables de diverses sources : Données, autres Sources ou Données, Obtenir des données, A partir d'autres sources selon la version

Oh je vois !

Merci

Bonjour !

J'ai rajouté ma version d'Excel

Merci Moul ça fonctionne très bien. Merci encore !!

Par contre j'ai oublié 2 choses :

- Comment faire pour rajouter de nouvelles références dans la colonne A ?

- Comment empêcher l'ajout de doublons ?

C'est a dire ?

Dans ton fichier base2 tu as une toute nouvelle entrée qui n'y était pas dans le fichier base1 ?

Normalement la il n'y a pas de doublons, le programme viens chercher une correspondance entre les deux fichier pour la colonne A.

Oui pardon, je n'avais pas pensé mais les mises à jours sont aussi bien en colonne qu'en ligne. Là j'ai rajouté des colonnes mais les nouvelles références que l'on rajoute dans base mais pas qui n'existe pas dans base ne sont pas rajouté.

1base1.xlsm (20.12 Ko)
1base2.xlsx (11.23 Ko)
Sub MàJ_B2_to_B1()
Dim FichierBase1 As Workbook
Dim FichierBase2 As Workbook
Dim FeuilleDonnéesBase1 As Worksheet
Dim FeuilleDonnéesBase2 As Worksheet
Dim Trouvé as boolean
Dim I, J As Integer

Set FichierBase1 = Workbooks("base1.xlsm")
Set FichierBase2 = Workbooks("base2.xlsx")

Set FeuilleDonnéesBase1 = FichierBase1.Worksheets("base1")
Set FeuilleDonnéesBase2 = FichierBase2.Worksheets("base2")

For J = 1 To FeuilleDonnéesBase2.Range("A65535").End(xlUp).Row
    Trouvé = false
    For I = 1 To FeuilleDonnéesBase1.Range("A65535").End(xlUp).Row
        If FeuilleDonnéesBase1.Cells(I, "A") = FeuilleDonnéesBase2.Cells(J, "A") Then
            FeuilleDonnéesBase1.Cells(I, "A").entirerow.value = FeuilleDonnéesBase2.Cells(J, "A").entirerow.value
            Trouvé = true
        Elseif i = FeuilleDonnéesBase1.Range("A65535").End(xlUp).Row and Trouvé = false then
            FeuilleDonnéesBase1.Cells(FeuilleDonnéesBase1.Range("A65535").End(xlUp).Row + 1, "A").entirerow.value = FeuilleDonnéesBase2.Cells(J, "A").entirerow.value
        end if
    Next
Next

Set FeuilleDonnéesBase1 = Nothing
Set FeuilleDonnéesBase2 = Nothing
Set FichierBase1 = Nothing
Set FichierBase2 = Nothing

End Sub

A tester

Parfait

Merci beaucoup d'avoir pris le temps. Je vais bosser dessus pour apprendre. Merci encore et bonne soirée !

Bonjour

Une solution PowerQuery

Actualiser par Données, Actualiser Tout après avoir mis à jour le nom du dossier où stocké base2.xlsx

1base1-2-pq.xlsx (30.24 Ko)

Edit : si tu as un message d'erreur :
Lancer PowerQuery, Fichier, Options et paramètres, Options de requête, partie GLOBAL : Confidentialité, Toujours ignorer les paramètres de niveau de confidentialité

Cela supprimera le message d'erreur.
A noter que cette option ne sert à rien dans la quasi totalité des cas et limite les possibilités, d'où son décochage.

Merci Chris !

Je suis en train de faire des tests mais je ne trouve pas PowerQuery J'ai Power Pivot c'est peut-être la même chose ? (j'avais évoqué powerQuery dans mon premier message car des amis m'en avait parlé).

Dans le code je vois un lien avec du DBF. Je pensais qu'Excel ne prenait plus en charge ce format de base de données (alors que j'en ai besoin...).

Peut-on exporter un fichier Excel directement en DBF ? Aujourd'hui je passe par Access

Public Rcd() As Variant

Sub Ouvrir_dbf()
Dim Rep As String, Tbl As String, T As Variant
Dim result As Long, i As Integer

    Rep = Rep_A_Lire
    If Not Rep = "" Then
        T = List_dbf(Rep)
        For i = 0 To UBound(T)
            Tbl = Replace(UCase(T(i)), ".DBF", "")
            If Not Tbl = "" Then
                Sheets.Add
                ActiveSheet.Name = Tbl
                result = Query(Rep, "SELECT * FROM " & Tbl)
                If Not UBound(Rcd, 2) = 0 Then
                    ActiveSheet.Range("A1").Resize(UBound(Rcd, 1), UBound(Rcd, 2)) = Rcd
                End If
            End If
        Next i
    End If
End Sub

Function Rep_A_Lire() As String
    ChDrive Left(ActiveWorkbook.Path, 1)
    ChDir ActiveWorkbook.Path
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "SELECTION DOSSIER DBF"
        .Show
        If .SelectedItems.Count > 0 Then Rep_A_Lire = .SelectedItems(1)
    End With
End Function

Function List_dbf(Rep As String) As String()
Dim i As Integer, Fichier As String, T() As String

    i = 0
    Fichier = Dir(Rep & "\*.dbf")
    Do While Fichier <> ""
        i = i + 1
        ReDim Preserve T(i)
        T(i - 1) = Fichier
        Fichier = Dir
    Loop
    If i > 0 Then List_dbf = T Else ReDim List_dbf(0)
End Function

Function Query(Rep As String, Req As String) As Long
Dim NDF As String, Cnx As Object, Rst As Object
Dim T As Variant, i As Long, j As Long, col As Integer

    On Error Resume Next
    Set Cnx = CreateObject("ADODB.Connection")
    Cnx.Provider = "MSDASQL"
    Cnx.Open "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=" & Rep & ";"
    Set Rst = CreateObject("ADODB.Recordset")
    Rst.Open Req, Cnx, 3

    Query = Rst.RecordCount
    col = Rst.Fields.Count
    ReDim Rcd(Query + 1, col)
    For j = 0 To col
        Rcd(0, j) = Rst.Fields(j).Name
    Next j

    If Not Query = 0 Then
        Rst.MoveFirst
        T = Rst.GetRows
        For i = 0 To Query
            For j = 0 To col
                Rcd(i + 1, j) = IIf(IsNull(T(j, i)), "", T(j, i))
            Next j
        Next i
    End If

    Cnx.Close
    Set Rst = Nothing
    Set Cnx = Nothing
End Function

En relisant le VBA je me rend compte que j'ai dû mélanger les macros

Je vais relancer un autre topic pour ma question sur le DBF mais si vous avez des pistes je suis preneur

RE

PowerPivot et PowerQuery sont deux choses différentes et tous deux intégrés dans 365 mais PoweQuery n'a pas d'onglet : on y accède via l'onglet Données

On ne peut exporter en format Access. Une base de données est un ensemble ingérable juste par un enregistrer sous.

On peut par VBA mettre à jour des tables via ADO ou DAO

Rechercher des sujets similaires à "mise jour fichier"