Opgelost Gegevens overzetten van een excel-file naar een excel-file

DutchOirs · maandag om 10:52

Goedemorgen,

Ben al dagen bezig om het voor elkaar te krijgen om van een gesloten (bron) excel-file gegevens te halen en deze neer over te zetten in het actieve (Doel) -file.
Het actieve (Doel) -file is het originele-file waarin ik updates maak.
De (oude) files zijn exact hetzelfde, alleen data kan verschillen.

Dacht als ik het originele-file leeg maak, vervolgens alle data overzet en dan opsla onder het bestaande (oude)-file met een ander version-nummer in de naam is het oude-file geupdated.
Heb alles werkend, alleen wil het overzetten van de data niet lukken.

Helaas kom er niet uit.
Wat ik al heb: - bron-file is geopend
- doel-file is leeg gemaakt van data
Nu zou de data overgezet moeten worden, maar helaas kom er even niet uit..

Heb onderstaande al reeds gemaakt voor het overzetten:
Deze Updates moeten worden overgebracht naar bestaande -files

Code:

'# HIERONDER DATA OVERZETTEN ##############################################################################################
  Dim bronPad As String, bronBestand As String, wbBron As Workbook, wsBron As Worksheet
  Dim wbDoel As Workbook, wsDoel As Worksheet, blok As Variant, blokRange As Range, b As Worksheet ', e As Long, dataBlok As Variant

'  On Error GoTo FoutAfhandeling
 
  '===Pas bestandslocatie aan===
  bronPad = ActiveWorkbook.Worksheets("Control").Range("D3")
  bronBestand = VolOldNaamTB & ".xls "
 
  If Dir(bronPad & bronBestand) = "" Then
    MsgBox "BronBestand bestaat niet: " & bronPad & bronBestand, vbCritical
    Exit Sub
  End If
 
  'Doel = huidig Bestand
  Set wbDoel = ThisWorkbook

  ' Bronbestand openen
  Set wbBron = Workbooks.Open(bronPad & bronBestand, ReadOnly:=True)
 
'===Lijst met: Bronblad, Bronbereik, Doelblad, Doelbereik===
'  blokken = Array( _
'  Array("Blad1", "A6:E41", "Blad1", "H6:L41", "Blad1", "O6:Q41", "Blad1", "A44", "Blad1", "I44", "Blad1", "A45:E83", "Blad1", "H45:L83", "Blad1", "O45:Q83", "Blad1", "S6:S41", "Blad1", "S45:S83"), _
'  Array("Blad1", "AA3:AA14", "Blad1", "AD33", "Blad1", "AI3:AP60", "Blad1", "AI63", "Blad1", "AI64:AP122", "Blad1", "AQ3:AQ122", "Blad1", "AR3:AR122"), _
'  Array("Control", "L22", "Control", "L26", "Control", "L30", "Control", "E28"), _
'  Array("Kasboek", "A3:G60", "Kasboek", "A63", "Kasboek", "A64:G121"), _
'  Array("Control", "I14", "Control", "L22", "Control", "L26", "Control", "L30") _
'  )
' hieronder test data
  blok = Array( _
  Array("Blad1", "A6:E41") _
  )

  '---------------------------------------------------------
  ' LOOP OVER ALLE BLADEN IN DE BRONFILE
  '---------------------------------------------------------
  For Each b In wbBron.Worksheets
    ' Blad moet ook bestaan in doelbestand
    On Error Resume Next
    Set wsDoel = wbDoel.Sheets(b.Name)
    If Err.Number <> 0 Then
      Err.Clear
 '     On Error GoTo FoutAfhandeling
      GoTo Volgendblad
    End If
 '   On Error GoTo FoutAfhandeling
    Set wsBron = b
    wsDoel.Unprotect

  '===Kopieer de blokken op dit blad===
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For i = LBound(blok) To UBound(blok)        ' Range proberen te laden
      On Error Resume Next
      Set blokRange = wsBron.Range(blok(i))
      If Err.Number <> 0 Then
        MsgBox "Ongeldig blok: " & blok(i), vbExclamation
        Err.Clear
 '       On Error GoTo FoutAfhandeling
        GoTo VolgendeBlok
      End If
  '    On Error GoTo FoutAfhandeling
      'Kopie exact op dezelfde plaats

      wsDoel.Range(blok(i)).Value = blokRange.Value
VolgendeBlok:
      Set blokRange = Nothing
    Next i
   
    ' PROTECT DOELBLAD NA SCHRIJVEN
      wsDoel.Protect
Volgendblad:
    wsDoel.Protect
    Set wsBron = Nothing
    Set wsDoel = Nothing
  Next b
 
  '===Bronbestand sluiten===
  wbBron.Close SaveChanges:=False
 
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
 
  MsgBox "Blokken zijn succesvol 1-op-1 overgezet!", vbInformation

Exit Sub

iemand die hierin begaafd is en enig idee heeft?
Thanks already

Dutch

snb · maandag om 11:14

Waar zijn de voorbeeldbestanden van bron en doel gebleven ?
Wat is het voordeel van uitsplitsen van gegevens naar verschillende doelbestanden ?

DutchOirs · maandag om 11:16

Goedemorgen snb,

Heb helaas geen voorbeeldbestanden. zit gevoelige informatie in.
Zoals ik al zei, alles werkt voor het overzetten, alleen dit stukje niet

peter59 · maandag om 11:18

Dit zegt Claude.

Gevonden problemen:

Spatie in bestandsnaam: ".xls " heeft een spatie aan het einde
blok(i) geeft een Array terug, geen String — je itereert over blok maar elk element is zelf een Array (bijv. Array("Blad1", "A6:E41")), dus wsBron.Range(blok(i)) klopt niet
Bladnaam en bereik zitten samen in één Array maar worden niet apart gebruikt
On Error Resume Next staat nog actief tijdens de Range-toewijzing, waardoor fouten worden genegeerd.

Code:

'# HIERONDER DATA OVERZETTEN ##############################################################################################

Dim bronPad As String, bronBestand As String
Dim wbBron As Workbook, wbDoel As Workbook
Dim wsBron As Worksheet, wsDoel As Worksheet
Dim blokken As Variant
Dim i As Long, j As Long
Dim bladNaam As String, bereik As String

On Error GoTo FoutAfhandeling

'=== Bestandslocatie ===
bronPad = ThisWorkbook.Worksheets("Control").Range("D3").Value
If Right(bronPad, 1) <> "\" Then bronPad = bronPad & "\"

bronBestand = VolOldNaamTB & ".xls"   ' <-- geen spatie!

If Dir(bronPad & bronBestand) = "" Then
    MsgBox "Bronbestand bestaat niet: " & bronPad & bronBestand, vbCritical
    Exit Sub
End If

'=== Doel = huidig bestand ===
Set wbDoel = ThisWorkbook

'=== Bronbestand openen ===
Set wbBron = Workbooks.Open(bronPad & bronBestand, ReadOnly:=True)

'=== Lijst: Array(bladnaam, bereik, bladnaam, bereik, ...) per blad-groep ===
' Structuur: elk sub-array = Array(bladNaam, bereik1, bereik2, ...)
blokken = Array( _
    Array("Blad1", "A6:E41", "H6:L41", "O6:Q41", "A44", "I44", "A45:E83", "H45:L83", "O45:Q83", "S6:S41", "S45:S83"), _
    Array("Blad1", "AA3:AA14", "AD33", "AI3:AP60", "AI63", "AI64:AP122", "AQ3:AQ122", "AR3:AR122"), _
    Array("Control", "L22", "L26", "L30", "E28"), _
    Array("Kasboek", "A3:G60", "A63", "A64:G121"), _
    Array("Control", "I14", "L22", "L26", "L30") _
)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'=== Loop over blokken ===
For i = LBound(blokken) To UBound(blokken)

    bladNaam = blokken(i)(0)   ' Eerste element = bladnaam

    ' Blad ophalen uit bron en doel
    On Error Resume Next
    Set wsBron = wbBron.Sheets(bladNaam)
    Set wsDoel = wbDoel.Sheets(bladNaam)
    On Error GoTo FoutAfhandeling

    If wsBron Is Nothing Or wsDoel Is Nothing Then
        MsgBox "Blad '" & bladNaam & "' niet gevonden in bron of doel.", vbExclamation
        Set wsBron = Nothing
        Set wsDoel = Nothing
        GoTo VolgendeBlok
    End If

    wsDoel.Unprotect

    ' Loop over bereiken (vanaf index 1, want 0 = bladnaam)
    For j = 1 To UBound(blokken(i))
        bereik = blokken(i)(j)

        On Error Resume Next
        wsDoel.Range(bereik).Value = wsBron.Range(bereik).Value
        If Err.Number <> 0 Then
            MsgBox "Fout bij bereik '" & bereik & "' op blad '" & bladNaam & "': " & Err.Description, vbExclamation
            Err.Clear
        End If
        On Error GoTo FoutAfhandeling
    Next j

    wsDoel.Protect

VolgendeBlok:
    Set wsBron = Nothing
    Set wsDoel = Nothing
Next i

'=== Bronbestand sluiten ===
wbBron.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "Blokken zijn succesvol overgezet!", vbInformation
Exit Sub

FoutAfhandeling:
    MsgBox "Fout " & Err.Number & ": " & Err.Description, vbCritical
    If Not wbBron Is Nothing Then wbBron.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

DutchOirs · maandag om 11:27

Hoi Peter,

Dat het verhaal niet helemaal klopte, had ik wel door maar niet exact waar...
Deze versie zou moeten werken?

snb · maandag om 11:36

@ dutch

Je zou inmiddels toch moeten weten dat voorbeeldbestanden nooit gevoelige gegevens bevatten.
Daardoor kunnen die voorbeeldbestanden altijd geplaatst worden.

peter59 · maandag om 12:01

DutchOirs zei:
Deze versie zou moeten werken?

Ik hoop van wel, maar probeer dit natuurlijk op een kopie en niet op het origineel, voor het geval dat het helemaal misgaat.

DutchOirs · maandag om 12:58

Hoi Peter,

e.e.a. werkt wel maar toch een foutmelding.
bij het rode gedeelte.

Geeft fout bij bereik 'Blad1'Methode Range van object_worksheet is mislukt.

Code:

  '---------------------------------------------------------
  ' LOOP OVER BLOKKEN
  '---------------------------------------------------------
    For e = LBound(blok) To UBound(blok)        ' Range proberen te laden
      bladNaam = blok(e)(0)       ' eerste element = bladnaam
      'Blad ophalenuit Bron en Doel
      On Error Resume Next
      Set wsBron = wbBron.Sheets(bladNaam)
      Set wsDoel = wbDoel.Sheets(bladNaam)
      On Error GoTo FoutAfhandeling
     
      If wsBron Is Nothing Or wsDoel Is Nothing Then
        MsgBox "Blad '" & bladNaam & "' niet gevondenin bron of doel.", vbExclamation
        Set wsBron = Nothing
        Set wsDoel = Nothing
        GoTo VolgendeBlok
      End If
      wsDoel.Unprotect
      'Loop over bereiken(vanaf index1, want 0 = bladnaam
      For j = 1 To UBound(blok(e))
        bereik = blok(e)(j)
        On Error Resume Next
        wsDoel.Range(bereik).Value = wsBron.Range(bereik).Value

hieronder de foutmelding........       
        If Err.Number <> 0 Then
          MsgBox "Fout bij bereik '" & bereik & "' op blad '" & bladNaam & "': " & Err.Description, vbExclamation
          Err.Clear
        End If
        On Error GoTo FoutAfhandeling
      Next j
     
      wsDoel.Protect
     
VolgendeBlok:
      Set wsBron = Nothing
      Set wsDoel = Nothing
    Next e

edmoor · maandag om 13:03

Welk rood gedeelte?

DutchOirs · maandag om 13:09

Hee die Edmoor, alles ok aan die kant?

Geeft geen kleur, heb hierboven net voor de foutmelding gezet "hieronder de foutmelding.......
Geeft als Foutmelding: Fout bij bereik A6:E41 op blad1 Typen komen niet met elkaar overeen???

Hoe kan dat als je een waarde op een lege cel zet??

denk dat de fout hierin zit:

Code:

        wsDoel.Range(bereik).Value = wsBron.Range(bereik).Value

edmoor · maandag om 13:12

Zonder voorbeeld brondocument is daar lastig iets over te zeggen.

PS.
Ik heb bij de moderator al eens aangegeven dat het gebruik van kleuren niet werkt in codetags.
Blijkbaar is daar geen simpele oplossing voor.
Jammer maar helaas.
In een eerdere versie van de forum software werkte dat prima.

peter59 · maandag om 13:20

Hier is iets dat Claude antwoordde.
Hopelijk werkt dit en klopt alles zoals het moet.
De echte VBA-specialisten weten hier vast wel raad mee.

De fout zit in de array-structuur. Het probleem is dat blokken(i)(0) de bladnaam pakt, maar daarna begint de bereik-loop bij j = 1 — en als het eerste bereik toevallig "Blad1" heet, dan probeert hij wsBron.Range("Blad1") te doen, wat uiteraard faalt.
De echte oorzaak: je hebt in je blokken array dezelfde bladnaam meerdere keren staan (bv. twee Array("Blad1", ...) entries). De tweede entry van blokken(i) wordt dan als bereik gelezen maar is eigenlijk ook "Blad1".
Kijk naar dit stuk:

Code:

blokken = Array( _
    Array("Blad1", "A6:E41", "H6:L41", ...), _
    Array("Blad1", "AA3:AA14", ...),  ' <-- weer "Blad1" als eerste element
    ...

De tweede sub-array begint ook met "Blad1" — dat klopt. Maar de loop leest index 0 als bladnaam en index 1 t/m einde als bereiken. Dat werkt alleen als de structuur 100% consistent is.
Oplossing — gebruik een duidelijkere structuur met een scheidingsteken:

Code:

'=== Structuur: "Bladnaam|Bereik" per item ===
blokken = Array( _
    "Blad1|A6:E41", _
    "Blad1|H6:L41", _
    "Blad1|O6:Q41", _
    "Blad1|A44", _
    "Blad1|I44", _
    "Blad1|A45:E83", _
    "Blad1|H45:L83", _
    "Blad1|O45:Q83", _
    "Blad1|S6:S41", _
    "Blad1|S45:S83", _
    "Blad1|AA3:AA14", _
    "Blad1|AD33", _
    "Blad1|AI3:AP60", _
    "Blad1|AI63", _
    "Blad1|AI64:AP122", _
    "Blad1|AQ3:AQ122", _
    "Blad1|AR3:AR122", _
    "Control|L22", _
    "Control|L26", _
    "Control|L30", _
    "Control|E28", _
    "Control|I14", _
    "Kasboek|A3:G60", _
    "Kasboek|A63", _
    "Kasboek|A64:G121" _
)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim item As Variant
Dim delen() As String

For Each item In blokken

    delen = Split(item, "|")
    bladNaam = delen(0)   ' bv. "Blad1"
    bereik   = delen(1)   ' bv. "A6:E41"

    ' Bladen ophalen
    On Error Resume Next
    Set wsBron = wbBron.Sheets(bladNaam)
    Set wsDoel = wbDoel.Sheets(bladNaam)
    On Error GoTo FoutAfhandeling

    If wsBron Is Nothing Or wsDoel Is Nothing Then
        MsgBox "Blad '" & bladNaam & "' niet gevonden.", vbExclamation
        Set wsBron = Nothing
        Set wsDoel = Nothing
    Else
        wsDoel.Unprotect

        On Error Resume Next
        wsDoel.Range(bereik).Value = wsBron.Range(bereik).Value
        If Err.Number <> 0 Then
            MsgBox "Fout bij '" & item & "': " & Err.Description, vbExclamation
            Err.Clear
        End If
        On Error GoTo FoutAfhandeling

        wsDoel.Protect
    End If

    Set wsBron = Nothing
    Set wsDoel = Nothing

Next item

wbBron.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "Klaar! Alle blokken overgezet.", vbInformation
Exit Sub

FoutAfhandeling:
    MsgBox "Fout " & Err.Number & ": " & Err.Description, vbCritical
    If Not wbBron Is Nothing Then wbBron.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Pas de bereiken aan naar wat jij nodig hebt, verwijder of voeg regels toe in de blokken = Array(...).

DutchOirs · maandag om 13:26

Claude = een AI ?

Ben al 3 dagen bezig met een AI en iedere keer anders

peter59 · maandag om 13:36

DutchOirs zei:
Claude = een AI ?

Yep.

DutchOirs · maandag om 13:38

Data wordt overgezet maar met constant de foutmelding bij iedere Array.

vraagje uit de losse pols

deze Array's moeten die:
A: alle cellen op Blad1 op één rij staan
B: moet de volgorde van werkbladen synchroon zijn met b.v. Blad 1 t/m blad 4?
Heb de Array's aangepast.

Code:

  blok = Array( _
  Array("Blad1", "A6:E41", "Blad1", "H6:L41", "Blad1", "O6:Q41", "Blad1", "A44", "Blad1", "I44", "Blad1", "A45:E83", "Blad1", "H45:L83", "Blad1", "O45:Q83", "Blad1", "S6:S41", "Blad1", "S45:S83", "Blad1", "AA3:AA14", "Blad1", "AD33", "Blad1", "AI3:AP60", "Blad1", "AI63", "Blad1", "AI64:AP122", "Blad1", "AQ3:AQ122", "Blad1", "AR3:AR122"), _
  Array("Kasboek", "A3:G60", "Kasboek", "A63", "Kasboek", "A64:G121"), _
  Array("Control", "L22", "Control", "L26", "Control", "L30", "Control", "E28", "Control", "I14", "Control", "L22", "Control", "L26", "Control", "L30") _
  )

Intussen de foutmelding blijft bij iedere Array, van
Fout bij bereik 'Blad1' op Blad1 / 'Kasboek' op Kasboek / 'Control' op Control: Methode Range van object_worksheet is mislukt

peter59 · maandag om 13:47

Hier is Claude weer.

Ik zie het probleem meteen! In jouw structuur wissel je steeds bladnaam + bereik af binnen één Array, maar de code verwacht een andere structuur. Daardoor leest hij "Blad1" als bereik en krijg je de fout.
Jouw structuur:

Code:

Array("Blad1", "A6:E41", "Blad1", "H6:L41", ...)
'      ^^^^^^   ^^^^^^^   ^^^^^^   ^^^^^^^
'      blad     bereik    blad     bereik    <-- steeds afwisselend

Oplossing: loop met stappen van 2:

Code:

blok = Array( _
    Array("Blad1", "A6:E41", "Blad1", "H6:L41", "Blad1", "O6:Q41", _
          "Blad1", "A44", "Blad1", "I44", "Blad1", "A45:E83", _
          "Blad1", "H45:L83", "Blad1", "O45:Q83", "Blad1", "S6:S41", _
          "Blad1", "S45:S83", "Blad1", "AA3:AA14", "Blad1", "AD33", _
          "Blad1", "AI3:AP60", "Blad1", "AI63", "Blad1", "AI64:AP122", _
          "Blad1", "AQ3:AQ122", "Blad1", "AR3:AR122"), _
    Array("Kasboek", "A3:G60", "Kasboek", "A63", "Kasboek", "A64:G121"), _
    Array("Control", "L22", "Control", "L26", "Control", "L30", _
          "Control", "E28", "Control", "I14", "Control", "L22", _
          "Control", "L26", "Control", "L30") _
)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim i As Long, j As Long
Dim subBlok As Variant

For i = LBound(blok) To UBound(blok)
    subBlok = blok(i)
    
    ' Loop met stap 2: j=0 is bladnaam, j+1 is bereik
    For j = LBound(subBlok) To UBound(subBlok) Step 2
    
        bladNaam = subBlok(j)       ' bv. "Blad1"
        bereik   = subBlok(j + 1)   ' bv. "A6:E41"
        
        On Error Resume Next
        Set wsBron = wbBron.Sheets(bladNaam)
        Set wsDoel = wbDoel.Sheets(bladNaam)
        On Error GoTo FoutAfhandeling
        
        If wsBron Is Nothing Or wsDoel Is Nothing Then
            MsgBox "Blad '" & bladNaam & "' niet gevonden.", vbExclamation
            Set wsBron = Nothing
            Set wsDoel = Nothing
            GoTo VolgendeItem
        End If
        
        wsDoel.Unprotect
        
        On Error Resume Next
        wsDoel.Range(bereik).Value = wsBron.Range(bereik).Value
        If Err.Number <> 0 Then
            MsgBox "Fout bij blad '" & bladNaam & "' bereik '" & bereik & "': " & Err.Description, vbExclamation
            Err.Clear
        End If
        On Error GoTo FoutAfhandeling
        
        wsDoel.Protect
        
VolgendeItem:
        Set wsBron = Nothing
        Set wsDoel = Nothing
        
    Next j
Next i

wbBron.Close SaveChanges:=False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "Klaar! Alle blokken overgezet.", vbInformation
Exit Sub

FoutAfhandeling:
    MsgBox "Fout " & Err.Number & ": " & Err.Description, vbCritical
    If Not wbBron Is Nothing Then wbBron.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Kern van de oplossing:

	Oud	Nieuw
Loop	`Step 1`	`Step 2`
Bladnaam	`subBlok(0)` eenmalig	`subBlok(j)` per paar
Bereik	`subBlok(1..n)`	`subBlok(j+1)` per paar

Ook handig: de foutmelding toont nu welk blad én welk bereik het probleem geeft, zodat je precies weet waar het misgaat.

edmoor · maandag om 13:50

Het vullen van de arrays gaat hier zonder enig probleem:

DutchOirs · maandag om 15:07

dus eigenlijk zou het zo moeten zijn:

Code:

  blok = Array( _
  Array("Blad1", "A6:E41", "H6:L41", "O6:Q41","A44", "I44", "A45:E83", "H45:L83", "O45:Q83", "S6:S41", "S45:S83", "AA3:AA14", "AD33", "AI3:AP60", "AI63", "AI64:AP122", "AQ3:AQ122", "AR3:AR122"), _
  Array("Kasboek", "A3:G60","A63", "A64:G121"), _
  Array("Control", "L22", "L26", "L30", "E28", "I14", "L22", "L26", "L30") _
  )

Yesss dit werkt, geen foutmelding meer.
Ook logisch als je nadenkt.. Advies kwam van AI pff 3 dagen aan het stoeien geweest en je had het zelf kunnen bedenken...

Peter en Edmoor, bedankt voor de hulp en meedenken...

Groetjes

Dutch

edmoor · maandag om 15:13

Ziet er op het eerste gezicht goed uit en kan je eenvoudig testen natuurlijk.
Zoals ik in #17 liet zien.

snb · maandag om 15:17

Definieer 2 namedranges: 1 in het bronbestand, 1 in het doelbestand

Names("doel")=Names("bron").value

Opgelost Gegevens overzetten van een excel-file naar een excel-file

Gebruiker

Verenigingslid

Gebruiker

Terugkerende gebruiker

Gebruiker

Verenigingslid

Terugkerende gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Inventaris

Gebruiker

Inventaris

Verenigingslid

Wij waarderen jouw privacy