Data kopiëren naar een ander bestand middels vba excel

[Robert Smidt]

Beste Helpmij-ers,

Ik heb een programma die de data kopieert van het ene werkblad naar het andere werkblad in hetzelfde bestand (Verkoopfactuur). Nu wil ik graag dat hij deze data naar een ander bestand (DebiteurenOverzicht) transporteert. De situatie is verder identiek en beide bestanden staan in dezelfde map.

Alvast heel hartelijk bedankt voor de medewerking.

Groeten, Robert

Windows("DebiteurenOverzicht.xlsm").Activate

'Oude situatie: Gegevens kopiëren van werkblad "Factuur" naar werkblad "Debiteuren, "
'Nieuwe situatie: Gegevens kopiëren van Bestand "Verkoopfactuur" werkblad "Factuur" naar bestand "Debiteurenoverzicht" werkblad "Debiteuren, "

'Op tabblad debiteuren lege rij zoeken
    Sheets("Debiteuren").Select
    Range("B10").Select 'deze cel moet gevuld zijn met (factuurnummer)!
    Selection.End(xlDown).Select
    rij = 1 + ActiveCell.Row

    Sheets("Debiteuren").Select
    ActiveSheet.Unprotect
    Cells(rij, 2) = Range("Factuur!Factuurnr.")
    Cells(rij, 3) = Range("Factuur!Factuurdatum")
    Cells(rij, 4) = Range("Factuur!Debiteurnr.")
    Cells(rij, 5) = Range("Factuur!Naam")
    Cells(rij, 6) = Range("Factuur!Totaal")
    Range("K6:N6").Select
    Selection.Copy
    Cells(rij, 11).Select
    ActiveSheet.Paste
    Cells(rij, 2).Select
    ActiveSheet.Protect

 

[etri]

Probeer eens je handelingen terwijl je 'macro opnemen' aan zet (in de Developer ribbon). Dan worden alle nodige stappen opgeslagen in een nieuwe module (als eerste 'Module1'). Dan kun je uit al die code je benodigde code halen en eventueel iets opschonen cq korter maken.

Verder zou ik werken met twee objecten van het type Workbook om daarin je werkboeken van Verkoopfactuur en Debiteurenoverzicht in op te slaan. Dus eerst twee nieuwe objecten aanmaken en dan per object aangeven naar welk werkboek die moet verwijzen; bijv. via:

Dim wbDebiteurenoverzicht As New Workbook
Set wbDebiteurenoverzicht = ActiveWorkbook

Vervolgens kan je via dat werkboek weer normaal verwijzen naar een worksheet zoals in de oorspronkelijke code, bijvoorbeeld:

wbDebiteurenoverzicht.worksheets("Debiteuren").Select

 

[Robert Smidt]

Bedankt voor jouw reactie,

Ik heb de volgende code gebruikt om het bestand te openen en dat werkt. Echter zet hij nog steeds de data niet over naar het doelbestand.

Dim WB As Workbook
Application.ScreenUpdating = False
On Error Resume Next
Set WB = Workbooks("DebiteurenOverzicht.xlsm") 'doelbestand
On Error GoTo 0
If WB Is Nothing Then
    Set WB = Workbooks.Open(Filename:="C:\Users\Gebruiker\Dropbox\Cashflow Control\Boekhouding klanten\-1. Testmap\DebiteurenOverzicht.xlsm")
    Else
    WB.Activate
End If

 

[etri]

Als ik naar je code kijk dan maak je een object WB naar het huidige werkboek (Debiteurenoverzicht) en als die niet bestaat dan open je hem alsnog. Ditzelfde moet je ook doen voor het tweede werkboek (bijvoorbeeld naar object WB2).

Vervolgens kun je via WB de cellen selecteren die je wilt kopiëren en dan plakken in WB2. De code hiervoor staat al bijna in je eerste voorbeeldcode. Ik denk dat je er wel uit komt... Zo niet, probeer dan eens het kopiëren en plakken terwijl je 'macro opnemen' aan het staan. Dan kun je nagenoeg direct die code gebruiken. Dan wel weer even gebruik maken van de WB en WB2 objecten die verwijzen naar je werkboeken.

Succes!

P.S. Ik kan je geen code toesturen want ik zit even niet achter een pc. En zo leer je toch ook het meeste, toch?!?

 

[Robert Smidt]

De code die ik gebruik is gebaseerd op twee verschillende werkbladen binnen één bestand, wanneer ik weet hoe die code eruit ziet (bij gebruik van twee bestanden), ben ik volledig geholpen. Ik hoef trouwens nooit twee bestanden te openen omdat ik het bronbestand altijd open heb (daar werk ik immers uit). Dus die code ken ik en werkt overigens ook. Wanneer jij mij kan helpen om de code:

Cells(rij, 2) = Range("Factuur!Factuurnr.") te wijzigen ben ik helemaal geholpen.

Alvast bedankt.

 

[etri]

Het zou bijvoorbeeld als volgt kunnen:

Dim WB As Workbook
Dim WB2 As Workbook

Application.ScreenUpdating = False

Set WB = ActiveWorkbook 'bronbestand; huidige geopende bestand

On Error Resume Next
Set WB2 = Workbooks("DebiteurenOverzicht.xlsm") 'doelbestand
On Error GoTo 0

If WB Is Nothing Then
    Set WB2 = Workbooks.Open(Filename:="C:\Users\Gebruiker\Dropbox\Cashflow Control\Boekhouding klanten\-1. Testmap\DebiteurenOverzicht.xlsm")
End If

'Op tabblad debiteuren lege rij zoeken
    WB.Sheets("Debiteuren").Range("B10").End(xlDown).Select
    rij = 1 + ActiveCell.Row

    With WB2.Sheets("Factuur")
        .Unprotect

        .Cells(rij, 2) = WB.Range("Factuur!Factuurnr.")
        .Cells(rij, 3) = WB.Range("Factuur!Factuurdatum")
        .Cells(rij, 4) = WB.Range("Factuur!Debiteurnr.")
        .Cells(rij, 5) = WB.Range("Factuur!Naam")
        .Cells(rij, 6) = WB.Range("Factuur!Totaal")
    
        WB.Range("K6:N6").Copy
        .Cells(rij, 11).Paste

        .Cells(rij, 2).Select
        .Protect
    End With

Ik weet niet of de functionaliteit zo klopt, want ik ken het spreadsheet niet, maar ik ga er vanuit dat het tweede spreadsheet moet worden 'onbeveiligd' om de nieuwe gegevens er in te kunnen kopiëren. Verder hoef je niet eerst te selecteren en dan in de selectie de kopiëren/plakken, maar kun je dit ook direct doen.

Ik heb de code niet kunnen controleren en doe dit uit mijn hoofd, dus er kunnen kleine foutjes in zitten.. ;-) Je krijgt denk ik wel een goed beeld van hoe het moet worden, hoop ik.

Succes!

 

[etri]

Ik denk trouwens dat er twee aanpassingen in de code nodig zijn als ik het nu goed begrijp (en nu ik het kan testen ), namelijk dat je moet controleren of WB2 bestaat (en niet WB):

If WB2 Is Nothing Then
[\code]

en dat je de laatste rij van het doelbestand wilt bepalen om daar de nieuwe gegevens wilt plakken:

[code]
WB2.Sheets("Factuur").Range("B10").End(xlDown).Select
[\code]

 

[Robert Smidt]

Hij geeft een foutmelding bij:

WB.Sheets("Debiteuren").Range("B10").End(xlDown).Select

Bovendien opent deze het doelbestand niet. De fout wordt ook weergegeven wanneer ik het doelbestand van te voren handmatig open.

 

[Robert Smidt]

Ben inmiddels wat verder, het systeem opent het doelbestand (de cursor staat trouwens niet op de lege regel maar op de laatste regel kolom B) en verder geeft deze nu een foutmelding bij:

.Cells(rij, 2) = WB.Range("Factuur!Factuurnr.")

 

[etri]

Ah, foutje van mijn kant. Tussen WB en Range moet nog het sheet object staan. De syntax is: {werkboek}.{sheet}.{range}.

Dus bijvoorbeeld:
.Cells(rij, 2) = WB.Worksheets("Debiteuren").Range("Factuur!Factuurnr.")

 

[Robert Smidt]

Helaas nog steeds niet ;-)

Helaas geeft hij nog steeds de foutmelding bij " .Cells(rij, 2) = WB.Worksheets("Debiteuren").Range("Factuur!Factuurnr.")". Hij opent het debiteurenoverzicht prima maar wat ik sowieso vreemd vind is dat cursor op de laatste gevulde regel staat i.p.v. een regel eronder. Daarom doe ik nog even de volledige code toekomen.

Dim WB As Workbook  'Bronbestand
Dim WB2 As Workbook 'Doelbestand

Application.ScreenUpdating = False

Set WB = ActiveWorkbook 'bronbestand; huidige geopende bestand

On Error Resume Next
Set WB2 = Workbooks("DebiteurenOverzicht.xlsm") 'doelbestand
On Error GoTo 0

If WB2 Is Nothing Then
    Set WB2 = Workbooks.Open(Filename:="C:\Users\Gebruiker\Dropbox\Cashflow Control\Boekhouding klanten\-1. Testmap\DebiteurenOverzicht.xlsm")
End If

'Op tabblad debiteuren lege rij zoeken
    ' WB2.Sheets("Debiteuren").Range("B10").End(xlDown).Select
    Sheets("Debiteuren").Select
    Range("B10").Select 'deze cel moet gevuld zijn met (factuurnummer)!
    Selection.End(xlDown).Select
    rij = 1 + ActiveCell.Row

    With WB2.Sheets("Debiteuren")
        .Unprotect
  
        .Cells(rij, 2) = WB.Worksheets("Debiteuren").Range("Factuur!Factuurnr.")
        .Cells(rij, 3) = WB.Worksheets("Debiteuren").Range("Factuur!Factuurdatum")
        .Cells(rij, 4) = WB.Worksheets("Debiteuren").Range("Factuur!Debiteurnr.")
        .Cells(rij, 5) = WB.Worksheets("Debiteuren").Range("Factuur!Naam")
        .Cells(rij, 6) = WB.Worksheets("Debiteuren").Range("Factuur!Totaal")
    
        WB.Range("K6:N6").Copy
        .Cells(rij, 11).Paste
        .Cells(rij, 2).Select
        .Protect
    End With

 

[etri]

Heb je anders een voorbeeldbestand dat je kan uploaden? Dan kan ik er eens naar kijken.

Via de code 'rij = 1 + ActiveCell.Row' zou je toch echt een nieuwe regel moeten selecteren.

Edit:

De volgende code zou wel moeten werken:

    Dim WB As Workbook  'Bronbestand
    Dim WB2 As Workbook 'Doelbestand
    Dim rij As Long

    Application.ScreenUpdating = True
    
    Set WB = ActiveWorkbook 'bronbestand; huidige geopende bestand

    On Error Resume Next
    Set WB2 = Workbooks("Debiteurenoverzicht.xlsm") 'doelbestand
    On Error GoTo 0
    
    If WB2 Is Nothing Then
        Set WB2 = Workbooks.Open(Filename:="C:\Users\Gebruiker\Dropbox\Cashflow Control\Boekhouding klanten\-1. Testmap\DebiteurenOverzicht.xlsm")
    End If

    'Op tabblad debiteuren lege rij zoeken
    Sheets("Debiteuren").Select
    Range("B10").Select 'deze cel moet gevuld zijn met (factuurnummer)!
    Selection.End(xlDown).Select
    rij = 1 + ActiveCell.Row

    With WB2.Sheets("Debiteuren")
        .Unprotect
  
        .Cells(rij, 2) = WB.Worksheets("Factuur").Range("Factuurnr.")
        .Cells(rij, 3) = WB.Worksheets("Factuur").Range("Factuurdatum")
        .Cells(rij, 4) = WB.Worksheets("Factuur").Range("Debiteurnr.")
        .Cells(rij, 5) = WB.Worksheets("Factuur").Range("Naam")
        .Cells(rij, 6) = WB.Worksheets("Factuur").Range("Totaal")
    
        .Cells(rij, 2).Select
        .Protect
    End With

 

[Robert Smidt]

Bekijk bijlage Verkoopfactuur.xlsmBekijk bijlage DebiteurenOverzicht.xlsm

Helaas nog steeds niet. Ik doe jou de twee bestanden toekomen. Het pad zal je even moeten wijzigen.

Alvast heel erg bedankt.

 

[etri]

Bij mij doet hij het wel. Heb je wel de code vervangen door bovenstaande code? Zo te zien namelijk niet...

Overigens doet de volgende code niets anders dan lege cellen kopieren, en kun je die regels net zo goed verwijderen...

        .Cells(rij, 2) = WB.Worksheets("Factuur").Range("Factuurnr.")
        .Cells(rij, 3) = WB.Worksheets("Factuur").Range("Factuurdatum")
        .Cells(rij, 4) = WB.Worksheets("Factuur").Range("Debiteurnr.")
        .Cells(rij, 5) = WB.Worksheets("Factuur").Range("Naam")
        .Cells(rij, 6) = WB.Worksheets("Factuur").Range("Totaal")

 

[Robert Smidt]

We zijn er bijna

Het werkt bijna perfect, op een kleinigheidje na. Wanneer het debiteurenoverzicht al geopend is, geeft deze een foutmelding bij: .Cells(rij, 2).Select en gaat het systeem naar de sheet Debiteuren van Verkoopfacturen.xlsm

Als dat probleem is opgelost werkt het volgens mij perfect, super bedankt hiervoor..

 

[etri]

Zet dan nog even de volgende code direct boven die regel: ".Activate"

Daarmee zet je eerst de focus op het juiste werkboek en spring je daarna naar de juiste cel.

 

[Robert Smidt]

Ik heb het zo gedaan en op andere plaatsen geprobeerd, echter geeft hij nu geen foutmelding meer, maar verspringt nog steeds naar de sheet "debiteuren" van het bronbestand en kopieert niets naar het doelbestand

        .Cells(rij, 2) = WB.Worksheets("Factuur").Range("Factuurnr.")
        .Cells(rij, 3) = WB.Worksheets("Factuur").Range("Factuurdatum")
        .Cells(rij, 4) = WB.Worksheets("Factuur").Range("Debiteurnr.")
        .Cells(rij, 5) = WB.Worksheets("Factuur").Range("Naam")
        .Cells(rij, 6) = WB.Worksheets("Factuur").Range("Totaal")
        .Activate
        .Cells(rij, 2).Select

 

[etri]

Uiteraard springt hij nog steeds naar die sheet want dat doet de code:

Sheets("Debiteuren").Select

Dus die regel verwijderen als je dat niet wilt.

Verder worden er bij mij wel waarden gekopieerd tussen de twee spreadsheets. Dus óf je hebt de code niet helemaal gekopieerd in je spreadsheet óf je verwacht een andere werking dan ik denk...

 

[Robert Smidt]

Ik heb " ' " voor Sheets("Debiteuren").Select gezet waardoor deze niet meer gelezen wordt, maar vreemd genoeg blijft het probleem zich voordoen. Ik doe jou daarom nogmaals de code toekomen, wellicht dat er bij mij toch iets anders staat dan bij jou. Volgens mij verwachten wij beiden dezelfde werking.

 Dim WB As Workbook  'Bronbestand
    Dim WB2 As Workbook 'Doelbestand
    Dim rij As Long

    Application.ScreenUpdating = True
    
    Set WB = ActiveWorkbook 'bronbestand; huidige geopende bestand

    On Error Resume Next
    Set WB2 = Workbooks("Debiteurenoverzicht.xlsm") 'doelbestand
    On Error GoTo 0

    If WB2 Is Nothing Then
        Set WB2 = Workbooks.Open(Filename:="C:\Users\Gebruiker\Dropbox\Cashflow Control\Boekhouding klanten\00. Testmap\DebiteurenOverzicht.xlsm")
    End If

    'Op tabblad debiteuren lege rij zoeken
    'Sheets("Debiteuren").Select
    Range("B10").Select 'deze cel moet gevuld zijn met (factuurnummer)!
    Selection.End(xlDown).Select
    rij = 1 + ActiveCell.Row

    With WB2.Sheets("Debiteuren")
        .Unprotect

        .Cells(rij, 2) = WB.Worksheets("Factuur").Range("Factuurnr.")
        .Cells(rij, 3) = WB.Worksheets("Factuur").Range("Factuurdatum")
        .Cells(rij, 4) = WB.Worksheets("Factuur").Range("Debiteurnr.")
        .Cells(rij, 5) = WB.Worksheets("Factuur").Range("Naam")
        .Cells(rij, 6) = WB.Worksheets("Factuur").Range("Totaal")
        .Activate
        .Cells(rij, 2).Select

        Range("K6:N6").Select
        Selection.Copy
        Cells(rij, 11).Select
        ActiveSheet.Paste
        Cells(rij, 2).Select
        ActiveSheet.Protect
        .Protect
    End With

 

[etri]

Bij het openen van een werkboek wordt deze automatisch actief. Als je een ander werkboek of sheet wilt activeren dan kan dat via het commando activate. Indien je een sheet van een niet actief werkboek wilt activeren dan moet je (uit mijn hoofd) eerst het werkboek en daarna de sheet activeren.

Bijvoorbeeld:

   WB.Activate
   WB.Worksheets("Factuur").Activate

Overigens zet je aan het begin van de code screenupdating uit waardoor je slechter kan volgen wat er allemaal gebeurd. Zet die daarom eerst maar aan totdat alles werkt zoals het moet. Daarna zou ik hem pas uit zetten.

   Application.ScreenUpdating = True

Succes!