Excel bestanden samenvoegen tot 1 bestand.

[Tweety1]

Ik ben op zoek naar een simple vba die een aantal bestanden (die bij elkaar in de zelfde map staan en beginnen met ...) samenvoegt tot 1 bestand.
Kolom A bevat steeds de zelfde waarde en kolom B veranderd steeds (Cellen kunnen niet dubbel ingevuld zijn in de verschillende bestanden)
Nu zou ik graag deze willen samenvoegen in een bestand.

Mvg

Kasper

 

[Elsendoorn2134]

Kasper,

En hoe wil je ze samenvoegen? Moeten de cellen in B bij elkaar opgeteld worden als A overeenkomt?
Moeten de verschillende regels van de bestanden gewoon onder elkaar geschreven worden zodat
je ze kan analyseren met een draaitabel? Kortom, even te weinig informatie in je vraag.
Een paar voorbeeldbestandjes doen ook wonderen.

Veel Succes.

 

[snb]

Als je echt op zoek bent: ook dit forum heeft een zoekfunktie. Dat verandert niet.

 

[Tweety1]

Zie voorbeeld bestand hoe ik graag de gegevens wil samenvoegen.


Bekijk bijlage VoorbeeldSamenvoegen.xlsx

 

[MDN111]

Dag Tweety1 !

Probeer deze eens.

Grtz,
MDN111.

 

[Elsendoorn2134]

Tweety1,

Probeer de volgende VBA code eens:

Public Sub Samenvoegen()
Dim sAcSheet As Worksheet
Dim aReeks(100, 2) As Double
Dim nNummer As Integer, dWaarde As Double
Dim nLoper1 As Integer
Dim nLoper2 As Integer

For Each sAcSheet In ActiveWorkbook.Sheets                'Doorloop alle tabbladen
    If sAcSheet.Name <> "Samengevoegd" Then         'Als tabblad naam ongelijk aan "Samengevoegd"
        nLoper1 = 0
        With Sheets(sAcSheet.Name).Range("A2")
        Do While .Offset(nLoper1, 0) <> ""    'Doorloop reeks vanaf cel A1
            nNummer = .Offset(nLoper1, 0)    'Kolom 1 is nummer
            dWaarde = .Offset(nLoper1, 1)    'Kolom 2 is waarde
            nLoper1 = nLoper1 + 1
            nLoper2 = 0
            Do While aReeks(nLoper2, 0) <> nNummer And aReeks(nLoper2, 0) <> 0
                nLoper2 = nLoper2 + 1                   'Doorloop reeks en zoek nummer
            Loop
            aReeks(nLoper2, 0) = nNummer                'Als gevonden of reeks(nloper2,0) is leeg
            aReeks(nLoper2, 1) = aReeks(nLoper2, 1) + dWaarde  'Nummer overnemen en waarde optellen
        Loop                                            'Naar volgende cel.
        End With
    End If
Next          'sAcSheet

'Tabel is nu gevuld, nu nog tonen.
nLoper1 = 0
With Sheets("Samengevoegd").Range("A2")                 'Ga naar tabblad met resultaten
    Do While aReeks(nLoper1, 0) <> 0                    'Doorloop de reeks
        .Offset(nLoper1, 0) = aReeks(nLoper1, 0)        'Druk de regels af.
        .Offset(nLoper1, 1) = aReeks(nLoper1, 1)
        nLoper1 = nLoper1 + 1
    Loop
End With

End Sub

Veel Succes.