Gegevens overzetten in ander Excel document

Vastenzeker · 20 jun 2022

Hallo forum gebruikers,

wie kan mij helpen met een voor mij onmogelijke koppeling of macro, om gegevens welke ik in het ene document zet, over te zetten naar een ander document.
Maar wel zodanig dat als ik document 2 sluit of leeg maak, de gegevens in document 1 blijven staan.

Concreet;
ik heb een document "Test sjabloon 2022" welke ik ga vullen met wedstrijduitslagen zoals;
1- Baannummer
2- Vóór punten (max 13)
3- Tégen punten (max 13)

Als dit blad is gevuld (na b.v. 3 wedstrijden), moeten de gegevens van de Vóór punten en Tégen punten overgezet worden naar het document "Vullen vanuit Sjabloon".
Dan wil ik het document "Test sjabloon 2022" kunnen legen en sluiten, maar de gegevens die naar het document "Vullen vanuit Sjabloon" zijn overgezet moeten daar uiteraard blijven staan.
Het document "Vullen vanuit Sjabloon" is in werkelijkheid veel groter en heeft 27 x 6 kolommen welke 1 tot 2 x per week moeten worden ingevuld.
Maar wel steeds in andere kolommen.
Iedere 6 kommen staat voor een speeldag. deze staat op datum. (zie bijlage Schermopname (1))
Er zijn per jaar 27 speeldagen dus 27 x 6 kolommen te vullen bij 3 partijen per dag per lid.

Is wat ik hierboven vaag te realiseren?

AHulpje · 20 jun 2022

Op het "Wedstrijdblad" is niet aangegeven om welke speelweek het gaat.
Hoe nu te bepalen naar welke kolommen in "Vullen vanuit sjabloon" gekopieerd moet worden?

In bijgaande versie wordt daarom naar de speelweek gevraagd, maar dat is eenvoudig aan te passen als de speelweek wordt opgenomen op het wedstrijdblad.
Zie module "ModuleOverzetten", daarin staat hardcoded de naam "Vullen vanuit sjabloon.xlsx", aanpassen naar behoeven.
Als "Vullen vanuit sjabloon.xlsx" nog niet geopend is dan wordt deze automatisch geopend, ervan uitgaande dat dat document in dezelfde folder staat als "Test sjabloon 2022.xlsm".

Vastenzeker · 20 jun 2022

Het Wedstrijdblad is steeds leeg en wordt per competitie wedstrijd gebruikt.
Ik kan me voorstellen dat ()NU overeen moet komen met het vullen vanuit Sjabloon document.
Het uiteindelijke doel van de resultaten moeten naar het hoofd document. Zie de bijlage Schermopname 1 op rij 1 staan de speeldagen.

Vastenzeker · 21 jun 2022

Nog even voor de duidelijkheid, in het hoofddocument staan de speeldatums voor een heel jaar vast.
Ik heb maar een deel van dit blad gekopieerd en de lidnamen vervangen door hoofdletters. Het document heet nu even "Vullen vanuit sjabloon".
In de bijlage heb ik in cel C1 een datum gezet.
De standen / resultaten van die speeldag moeten dan vanuit document "Test sjabloon" komen en naar document "Vullen vanuit sjabloon" gekopieerd worden naar de zelfde datum.
Dan moet het document "Test sjabloon" worden opgeslagen op de bewuste datum en vervolgens geleegd worden zodat deze wederom gebruikt kan worden voor de volgende datum. (Het document "Test sjabloon" wordt steeds van nieuwe namen voorzien d.m.v. een koppeling met Acces.) vandaar ook sjabloon!

Uiteraard moeten de gekopieerde resultaten in het hoofddocument (nu tijdelijk;"Vullen vanuit sjabloon") blijven staan.

AHulpje · 21 jun 2022

Zie bijlagen.
Gegevens worden nu overgezet op basis van huidige datum.
Sjabloon wordt na overzetten opgeslagen als "Sjabloon dd-mm-jjjj.xlsm".

Vastenzeker · 21 jun 2022

Vraagje; zouden jou 2 voorbeeld documenten met de macro button "Overzetten" zo moeten werken?
Of moet ik nog iets in de VBA code veranderen?
Nu krijg ik een foutmelding, zie bijlages.

AHulpje · 21 jun 2022

Als je mijn versie van "Vullen vanuit sjabloon.xlsx" hebt gebruikt zou het moeten werken, maar waarschijnlijk heeft die bij het downloaden een volgnummertje (1) gekregen, zodat hij jouw versie gebruikte. Met mijn versie gaat het goed.
Verder zit er nog een klein foutje in de macro waardoor de fout niet goed werd afgevangen.

Vervang

If kolomDoel = 0 Then

door

If kolomDoel <= 0 Then

Je krijgt dan (met jouw versie van "Vullen vanuit sjabloon.xlsx") de melding dat de datum niet gevonden is.

Vastenzeker · 22 jun 2022

@ AHulpje,

Bedankt het werkt nu bij mij ook.
Ik moet nu nog zien dat ik de juiste (mijn bestaande) documenten kan gaan gebruiken.
Nog even puzzelen dus.

Groet, Vastenzeker.

Vastenzeker · 30 jun 2022

@Ahulpje,

het is mij nog niet gelukt om jou macro te gebruiken in mijn hoofd documenten.
Ik krijg een foutmelding. (zie bijlage)

Haije · 30 jun 2022

@vastenzeker,

jouw bijlage geeft aan waar de foutmelding zich voor doet, niet wat de foutmelding is....

Vastenzeker · 30 jun 2022

@Ahulpje,

ik denk dat ik weet waarom het niet werkt bij mij.
Jou document "Vullen vanuit Sjabloon" heeft maar 1 tabblad, terwijl mijn document 13 tabbladen heeft.

Kan jou macro hierop worden aangepast?
Zo ja, wil jij dit dan in de VBA code aanpassen?

AHulpje · 30 jun 2022

Beetje gokken zo.
Bestaat werkblad "Wedstrijdblad"?
Wat zijn de waarden van rijBron, rijDoel en kolomDoel? Die waarden kun je zien door de muisaanwijzer stil te houden boven de betreffende variabelen in de gele regel.

AHulpje · 30 jun 2022

Onze berichten hebben elkaar gekruist.
Kun je het document "Vullen vanuit sjabloon" met de 13 werkbladen uploaden? Anders blijft het gokken.

Vastenzeker · 30 jun 2022

@AHulpje

Hierbij het hele document met uiteraard verwijderde persoonsgegevens.

voor de duidelijkheid;
het tabblad "Wedstrijdblad" wordt deels gevuld door een Acces document.
Als dat klaar is moeten de gegevens overgezet worden d.m.v. de door jou gemaakte button "Overzetten"
naar het tabblad "Invulblad".
In dit geval onder de datum 30 juni 2022 kolommen CU:CZ
of als je morgen verder gaat naar 1 juli 2022 kolommen DA

F.
Maar dat zal je ongetwijfeld begrijpen.

AHulpje · 30 jun 2022

Als je van tevoren had verteld dat er sprake was van maar één Exceldocument dan was het een stuk minder werk geweest.
Bijgaand een sterk versimpelde versie.
Het opslaan van het wedstrijdblad als "Wedstrijdblad dd-mm-yyyy.xlsx" mag je zelf proberen, als dat tenminste nog gewenst is.

Vastenzeker · 1 jul 2022

@AHulpje,

het spijt me dat ik niet duidelijk genoeg heb aangegeven dat het 1 document betrof.
Het is uiteraard niet mijn bedoeling om jou aan extra werk te helpen.
Nogmaals mijn excuses.

Ik heb geprobeerd om het Wedstrijdblad te laten kopiëren naar het sjabloon door jou [' ] vóór de formules weg te halen.
Maar daar red ik het niet mee blijkbaar.

Mijn bedoeling is om als het wedstrijdblad van het hoofddocument is gevuld met uitslagen dat dan door jou button "Overzetten" de uitslagen naar het tabblad "Wedstrijdblad" worden overgezet (dit werkt nu prima) en dat er een kopie van dat Wedstrijdblad wordt opgeslagen als sjabloon 2022 in dezelfde werkmap.
Het sjaboon 2022 heeft 3 tabbladen; t.w. Wedstijdblad, Leden en Printmodel.

De bedoeling van deze kopie is om terug te kunnen kijken welk lid er hoeveel punten heeft gehaald.
Daar staan n.l. de namen en de uitslagen per gespeelde datum in.

Zou jij zo vriendelijk willen zijn dit voor mij in orde te maken?

Code:

Option Explicit

Sub Overzetten()
'Zoek huidige datum in werkblad "Invulblad"
'Voor alle aanwezige lidnummers in werkblad "Wedstrijdblad":
'- Zoek lidnummer in werkblad "Invulblad" N.B. Lidnummer met voorloopnul!
'- Kopieer de voor- en tegenpunten van Wedstrijdblad naar Invulblad.

    Dim kolomDoel As Integer
    Dim lidnr As String

    kolomDoel = ZoekKolomDatum(Date) - 1
    If kolomDoel <= 0 Then
        MsgBox "Datum " & Date & " niet gevonden.", vbCritical, "Foutmelding"
        Exit Sub
    End If
    Dim rijBron As Integer
    Dim rijDoel As Integer
    rijBron = 7
    
    'Nu de voor- en tegenpunten kopieren per lidnummer
    Application.ScreenUpdating = False
    Do While Cells(rijBron, 1) > 0
        lidnr = Format(Cells(rijBron, 1), "000")
        rijDoel = ZoekRijLid(lidnr)
        If rijDoel > 0 Then
            KopieerLid rijBron, rijDoel, kolomDoel
        End If
        rijBron = rijBron + 1
    Loop
    'OpslaanAls
    Application.ScreenUpdating = True
    MsgBox "Overzetten van wedstrijdblad d.d. " & Date & " naar invulblad is gereed.", vbInformation, "Mededeling"
    'ActiveWorkbook.Close
End Sub

Function ZoekKolomDatum(datum) As Integer
'    Dim foundRange As Range
'    Set foundRange = Sheets("Invulblad").Range("1:1").Find(What:=datum, LookIn:=xlValues, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
'    If foundRange Is Nothing Then
'        ZoekKolomDatum = 0
'    Else
'        ZoekKolomDatum = foundRange.Column
'    End If
'    Set foundRange = Nothing
'   Primitief, maar werkt, i.t.t. bovenstaande
    Dim col As Integer
    With Sheets("Invulblad")
        For col = 4 To 1000 Step 6
            If .Cells(1, col) = datum Then
                ZoekKolomDatum = col
                Exit Function
            End If
        Next
    End With
    ZoekKolomDatum = 0
End Function

Function ZoekRijLid(lidnr) As Integer
    Dim col As Integer
    Dim foundRange As Range
    Set foundRange = Sheets("Invulblad").Range("A:A").Find(What:=lidnr, LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)

    If foundRange Is Nothing Then
        MsgBox "Lidnummer " & lidnr & " niet gevonden in Invulblad.", vbCritical, "Foutmelding"
        ZoekRijLid = 0
    Else
        ZoekRijLid = foundRange.Row
    End If
    Set foundRange = Nothing
End Function

Function KopieerLid(rijBron, rijDoel, kolomDoel)
'   Kopieer de voor- en tegenpunten per lid van Wedstrijdblad naar Invulblad
    Dim sheetWedstrijdblad As Worksheet
    Set sheetWedstrijdblad = Sheets("Wedstrijdblad")
    With Sheets("Invulblad")
        'Ronde 1
        .Cells(rijDoel, kolomDoel) = sheetWedstrijdblad.Cells(rijBron, 4)
        .Cells(rijDoel, kolomDoel + 1) = sheetWedstrijdblad.Cells(rijBron, 5)
        'Ronde 2
        .Cells(rijDoel, kolomDoel + 2) = sheetWedstrijdblad.Cells(rijBron, 9)
        .Cells(rijDoel, kolomDoel + 3) = sheetWedstrijdblad.Cells(rijBron, 10)
        'Ronde 3
        .Cells(rijDoel, kolomDoel + 4) = sheetWedstrijdblad.Cells(rijBron, 14)
        .Cells(rijDoel, kolomDoel + 5) = sheetWedstrijdblad.Cells(rijBron, 15)
    End With
End Function

Function OpslaanAls()
    ActiveWorkbook.SaveAs Filename:= _
        ActiveWorkbook.Path & "\" & "Sjabloon 2022 " & Format(Date, "dd-mm-yyyy"), _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Function

AHulpje · 1 jul 2022

Aha, nu zijn er weer twee documenten.

Ik neem aan dat je met:
Mijn bedoeling is om als het wedstrijdblad van het hoofddocument is gevuld met uitslagen dat dan door jou button "Overzetten" de uitslagen naar het tabblad "Wedstrijdblad" worden overgezet.
eigenlijk dit bedoelde:
Mijn bedoeling is om als het wedstrijdblad van het hoofddocument is gevuld met uitslagen dat dan door jouw button "Overzetten" de uitslagen naar het tabblad "Invulblad" worden overgezet.

En dat er functionaliteit moet worden toegevoegd die de inhoud van het zojuist "overgezette" werkblad "Wedstrijdblad" naar het document "Sjabloon 2020.xlsx" kopieert in het daar aanwezige werkblad "Wedstrijdblad", waarna het document "Sjabloon 2020.xlsx" wordt opgeslagen als "Sjabloon 2020-mm-dd.xlsx".

Klopt dat?

Vastenzeker · 1 jul 2022

Ja,

precies zoals jij schrijft.

Mijn bedoeling is om als het wedstrijdblad van het hoofddocument is gevuld met uitslagen dat dan door jouw button "Overzetten" de uitslagen naar het tabblad "Invulblad" worden overgezet.

Ik maakte weer een foutje.
De spanning wordt mij blijkbaar te groot.:d
Ben blij dat je het begrijpt.

AHulpje · 1 jul 2022

Ik ga er vanuit dat het document "Sjabloon 2022.xlsm" in dezelfde map als je hoofddocument staat. Volgend jaar even in de broncode aanpassen of die naam variabel maken met de functie Year(Date).
De module "ModuleOverzetten" kun je uit dat document verwijderen, evenals de knop "Overzetten".

Voeg onderstaande functie toe aan module "ModuleOverzetten" in je hoofddocument.

Code:

Function OpslaanAls()    Dim fileNaam As String
    Dim workbookMacro As Workbook
    Set workbookMacro = ActiveWorkbook
    Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & "Sjabloon 2022.xlsm"
    Sheets("Wedstrijdblad").Unprotect
    workbookMacro.Sheets("Wedstrijdblad").Range("A7:AG108").Copy Sheets("Wedstrijdblad").Range("A7")
    fileNaam = "Sjabloon 2022-" & Format(Month(Date), "00") & "-" & Format(Day(Date), "00")
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & fileNaam, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    ActiveWorkbook.Close (False)
    MsgBox fileNaam & " opgeslagen.", vbInformation, "Wedstrijdblad"
End Function

en wijzig het einde van Sub Overzetten als volgt:

Code:

    OpslaanAls
    Application.ScreenUpdating = True
    MsgBox "Overzetten van wedstrijdblad d.d. " & Date & " naar invulblad is gereed.", vbInformation, "Mededeling"
End Sub

Succes.

snb · 1 jul 2022

Als gewone macro:

Code:

Sub M_snb()
  c00=ThisWorkbook.Path & "\Sjabloon 2022"

  with getobject(c00 & .xlsm")
    thisworkbook.Sheets("Wedstrijdblad").Range("A7:AG108").Copy .Sheets("Wedstrijdblad").Range("A7")
    .saveas c00 & Format(Date, "-mm_dd"),51
    .Close 0
  end with
End Sub

Gegevens overzetten in ander Excel document

Gebruiker

Bijlagen

Terugkerende gebruiker

Bijlagen

Gebruiker

Bijlagen

Gebruiker

Bijlagen

Terugkerende gebruiker

Bijlagen

Gebruiker

Bijlagen

Terugkerende gebruiker

Gebruiker

Gebruiker

Bijlagen

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Gebruiker

Bijlagen

Terugkerende gebruiker

Bijlagen

Gebruiker

Bijlagen

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Verenigingslid

Wij waarderen jouw privacy