bestand openen en waarden overnemen en sluiten

[Kim2011]

Is het mogelijk om van de bestanden in de bijlage een macro te maken in het bestand invulformulier waarmee de gegevens achter appels naar de juiste datum in het bestand appels gaan en datzelfde voor peren. In appels en peren zijn 2 tabs. Mogelijk komen er nog meer bestand bij, dus als een lus zou kunnen is het helemaal fijn.

 

[Roncancio]

Is het niet handiger op alles in 1 bestand te houden?
En om in de kolommen aantallen & gewicht en de waardes in de regels zodat je meer gegevens op het werkblad kwijt kunt?
Wat als een datum niet gevonden wordt?

Met vriendelijke groet,


Roncancio

 

[Kim2011]

Bedankt voor je bericht.

Het doel is om elke maand deze gegevens in te vullen. Nu heb ik appels en peren als voorbeeld, maar dit kunnen er later wel honderd soorten worden. Dan is het handiger om alles op 1 pagina in te kunnen voeren en het dan in te laten vullen, dan dat ik elk bestand moet openen om het te veranderen.
Ik ben zelf begonnen met een macro, maar het klopt niet helemaal geloof ik. Ik weet sowieso niet hoe ik een lus moet maken.

Sub Knop_Klikken()
    Dim x As Integer, y As Integer, p As Integer, q As Integer
    With Workbooks("Invulformulier.xlsm").Sheets(1)
        If .[h1] < 40330 Or .[h1] > 41059 Then
            Exit Sub
        End If
    End With
    On Error Resume Next
    Workbooks.Open ("Appels.xlsm")
    On Error GoTo 0
    With Workbooks("Appels.xlsm").Sheets(1)
        For x = 2 To 5 Step 3
            For y = 2 To 13
                If .Cells(x, y) = Workbooks("Invulformulier.xlsm").Sheets(1).[f1] Then
                    .Cells(x, y).Offset(1) = Workbooks("Invulformulier.xlsm").Sheets(1).[c3]
                    .Cells(x, y).Offset(2) = Workbooks("Invulformulier.xlsm").Sheets(1).[d3]
                Else
                    p = x: q = y + 1: If q = 14 Then p = x + 3: q = 3
                    If p = 8 Then
                        x = p - 3: y = 13
                        .Cells(x, y).Offset(1) = Workbooks("Invulformulier.xlsm").Sheets(1).[c3]
                        .Cells(x, y).Offset(2) = Workbooks("Invulformulier.xlsm").Sheets(1).[d3]
                    End If
                End If
                If .Cells(x, y) < Workbooks("Invulformulier.xlsm").Sheets(1).[f1] And .Cells(p, q) > Workbooks("Invulformulier.xlsm").Sheets(1).[f1] Then
                    .Cells(x, y).Offset(1) = Workbooks("Invulformulier.xlsm").Sheets(1).[c3]
                    .Cells(x, y).Offset(2) = Workbooks("Invulformulier.xlsm").Sheets(1).[d3]
                    GoTo volgende
                End If
            Next y
        Next x
    End With
End Sub