Macro importeren gegevens tabel vanuit ander excel worksheet

[Amstellovich1967]

Goedemiddag Experts,

Ik heb een bestand genaamd "Bron afwijkingen" die dagelijks wordt ververst door andere medewerkers.
Dit bestand moet in tact blijven waardoor ik een ander bestand genaamd "Afwijkingen" heb aangemaakt waar ik graag door middel van een macro alle gegevens vanuit "Bron afwijkingen" wil importeren in bestand "Afwijkingen".
De gegevens zou ik graag middels de button "Importeren" willen laten verlopen waarbij de gegevens telkens onderaan de laatste regel worden toegevoegd.
Helaas kom ik hier zelf niet uit en vraag jullie hulp hoe dit voor elkaar te krijgen.

Met vriendelijke groet,
René

 

[globe]

De bestanden verschillen qua opmaak, aantal kolommen. Is dat de bedoeling?

Handiger om ze het zelfde te houden denk ik?

 

[Amstellovich1967]

@globe: De kolommen moeten hetzelfde zijn, ik heb het juiste bestand toegevoegd, sorry van mijn kant.

 

[peter59]

Als ik het goed heb gelezen dan heb je mijn inziens helemaal geen macro nodig.
Dan kan power query volstaan.

 

[Amstellovich1967]

Power Query? Is dat binnen Excel?

 

[jverkerk]

Gedaan met power Query.
Kijk in afwijkingen en kijk naar de Query, je kunt hem zelfs elke minuut verversen.
Weet niet of er bestanden bijkomen iedere keer of vervangen worden.

 

[peter59]

Hallo,

Ja, power query is een onderdeel van excel en dat vanaf versie 2016.
Onderstaand een link zoals het zou kunnen. (handleiding)
Jverkerk heeft dat al een beetje voor je gedaan.
https://excel-practice-online.com/tools/power_query_combine_workbooks/

@jverkerk

Kijk in afwijkingen en kijk naar de Query, je kunt hem zelfs elke minuut verversen.

Die elke minuut verversen ben ik zelf geen voorstander van.
Je bent ergens iets aan het wijzigen, aanpassen of whatever en dan begint ineens alles te verversen oftewel je kan absoluut niets meer.

 

[jverkerk]

@peter59
Ben ik met je eens met de hand verversen is het beste, maar er zijn natuurlijk legio mogelijkheden en opties, om het maar even aan te geven.

 

[Amstellovich1967]

@peter59 en @jverkerk:
Dank je wel voor de duidelijke informatie en hulp. Het bestand Bron afwijkingen wordt elke dag aangevuld met afwijkingen.
Ik ga mij verdiepen in de aanpassing die gemaakt is en de handleiding doornemen.
Als ik de query elke dag ververst neemt hij dan ook de toegevoegde regels mee of moet ik dan extra handeling doen?
Ben super blij met jullie steun.

Groet,
René

 

[snb]

In VBA:

Private Sub Workbook_Open()
  With GetObject("G:\OF\Bron Afwijkingen.xlsx")
     .Sheets(1).ListObjects(1).DataBodyRange.Copy Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
     .Close 0
  End With
End Sub

 

[jverkerk]

Als er regels bijkomen in het bestand Bron afwijkingen, dan eerst opslaan en dan handmatig vernieuwen gegevens bestand afwijkingen. Bij de Query kun je bij eigenschappen diverse mogelijkheden instellen, maar handmatig vernieuwen ben ik net als @peter59 een voorstander van.
Speel maar eens met de query of probeer hem zelf aan te maken, daar zijn nog veel mogelijkheden te maken die je zo weer ongedaan kunt maken.

 

[globe]

Ik heb een soortgelijk script wat ik regelmatig gebruik. Even aangepast naar jouw bestanden.

Script kijkt in kolom G naar de productnaam, deze moeten uniek zijn. Vervolgens kijkt het in de bron of de rij in de afwijkingen bestaat.
Indien niet wordt er in kolom V een melding gemaakt. Staat er een extra rij in de bron maar niet in de afwijkingen dan wordt de rij gekopieerd.

Verschillen tussen bron en afwijkingen kleuren rood.

door ChatGPT het script laten verduidelijken.

Sub VergelijkEnKopieerRijen()
    Dim wsA As Worksheet, wsB As Worksheet
    Dim diffCount As Long
    Dim laatsteRijA As Long, laatsteRijB As Long
    Dim huidigeRijA As Long
    Dim rijB As Long
    Dim rijBestaatInB As Boolean
    Dim rijBestaatInA As Boolean

    ' Stel de te vergelijken werkbladen in
    On Error Resume Next
    Set wsA = Workbooks("Bron Afwijkingen.xlsx").Worksheets("AFWIJKINGEN")
    Set wsB = Workbooks("Afwijkingen.xlsm").Worksheets("AFWIJKINGEN")
    On Error GoTo 0

    If wsA Is Nothing Or wsB Is Nothing Then
        MsgBox "Een of beide werkbladen niet gevonden.", vbExclamation
        Exit Sub
    End If

    ' Wis de inhoud van kolom V in Werkblad B
    wsB.Range("V:V").ClearContents

    ' Zoek de laatste rij in elk werkblad
    laatsteRijA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    laatsteRijB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row

    ' Loop door elke rij in Werkblad A
    For huidigeRijA = 1 To laatsteRijA
        ' Ga ervan uit dat de rij niet bestaat in Werkblad B
        rijBestaatInB = False

        ' Loop door elke rij in Werkblad B om te controleren of de rij bestaat
        For rijB = 3 To laatsteRijB + 2
            If wsB.Cells(rijB, 7).Value = wsA.Cells(huidigeRijA, 7).Value Then ' Vermoedelijk is kolom G kolom 7
                ' De rij bestaat in Werkblad B
                rijBestaatInB = True
                Exit For
            End If
        Next rijB

        If Not rijBestaatInB Then
            ' Rij bestaat niet, voeg deze toe aan Werkblad B
            laatsteRijB = laatsteRijB + 1 ' Werk laatsteRijB bij omdat er een nieuwe rij wordt toegevoegd
            wsB.Rows(laatsteRijB).Value = wsA.Rows(huidigeRijA).Value
            diffCount = diffCount + 1
        End If
    Next huidigeRijA

    ' Loop door elke rij in Werkblad B
    For rijB = 3 To laatsteRijB
        ' Ga ervan uit dat de rij niet bestaat in Werkblad A
        rijBestaatInA = False

        ' Loop door elke rij in Werkblad A om te controleren of de rij bestaat
        For huidigeRijA = 1 To laatsteRijA
            If wsB.Cells(rijB, 7).Value = wsA.Cells(huidigeRijA, 7).Value Then ' Vermoedelijk is kolom G kolom 7
                ' De rij bestaat in Werkblad A
                rijBestaatInA = True
                Exit For
            End If
        Next huidigeRijA

        If Not rijBestaatInA Then
            ' Rij bestaat niet in Werkblad A, voeg tekst toe aan kolom V in Werkblad B
            wsB.Cells(rijB, 22).Value = "niet in bron"
            diffCount = diffCount + 1
        End If
    Next rijB

    ' Toon een bericht met het aantal gevonden verschillen
    MsgBox diffCount & " verschillen gevonden tussen Bron en Afwijkingen.", vbInformation
End Sub