waardes kopieren

[don42]

Als het niet lukt om dit voor elkaar te krijgen (wat heel jammer zou zijn)
dan zou ik ook kunnen leven met de optie die alles kopieerd naar tabblad facturen in de huidige map
deze code

Private Sub CommandButton6_Click()
Application.ScreenUpdating = False
Dim i As Long
i = Sheets("facturen").Range("A" & Rows.Count).End(xlUp).Row
Sheets("facturen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array([g16], [b15], [n19], [i45])
Application.ScreenUpdating = True
Range("p31").Value = Range("p31").Value + 1
Application.Goto Sheets("facturen").Range("a1")
End Sub

Doet dat perfect maar dan 1 voor 1
Is het makkelijker om alle sheets (tussen start en Herinnering) te kopieren naar tabblad facturen in mijn huidige werkmap ben ik ook al geholpen
dan kopieer ik op het einde van de maand wel handmatig naar de map C:\bewaren\facturen.xlsx

 

[HSV]

Jammer dat het bij jou niet werkt.
Hier werkt het perfect, en kan zo niet iets bedenken waarom het bij jou niet kan werken.

Plaatst het bestand eens zodat we kunnen zien wat er aan schort.
Straks wordt het een welles/nietes spelletje waar ik geen zin in heb.

 

[don42]

Ik ben (moet) een weekend weg met de vrouw haha ik plaats het bestand maandag. Hoop dat we een oplossing vinden. Fijne Pasen Don

 

[don42]

bij deze mijn voorbeeld

Bekijk bijlage maart.xlsb

er staat nog maar 1 factuur in omdat het anders te groot zo worden om te versturen
klik op nieuwe factuur om een paar facturen aan te maken.
hoop dat iemand ziet waar de fout zit.

Don

 

[don42]

Private Sub CommandButton2_Click()
Dim sh As Worksheet, Tw As Worksheet
Application.ScreenUpdating = False
Set Tw = ThisWorkbook.Sheets(1)
Workbooks.Open "d:\bewaren\facturen.xlsx"
  With ActiveWorkbook
   For Each sh In .Sheets
[COLOR="#FF0000"]If sh.Index > .Sheets("Start").Index And sh.Index < .Sheets("Herinnering").Index Then[/COLOR]
     MsgBox sh.Name
     sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(CDate(Tw.[g16]), Tw.[b15], Tw.[n19], Tw.[i45])
   End If
  Next sh
  .Close 1
  End With
End Sub

De rode regel is de foutmelding !

 

[don42]

Beste experts

Ik ben bang dat mijn vraag niet duidelijk genoeg was
merk nu dat het iets uitmaakt als ik tabbladen aanmaak in de file facturen
Dit is niet de bedoeling.
Facturen.xlsx is 1 tablad facturen met 4 kolommen
daar had ik graag 4 waardes per regel nl. factuurnr. - datum - naam en bedrag
In mijn werkboek heb ik aan het einde van de maand een 60 tabbladen (rekeningen) aangemaakt
Die staan tussen de tabbladen Start en Herinnering
Nu graag een code die de 4 waardes per rekening naar d:/bewaren/facturen.xlsx kopieerd
Bekijk bijlage facturen.xlsx meer is het niet dan 4 lege kolommen

HSV
heeft er dit van gemaakt

Private Sub CommandButton2_Click()
Dim sh As Worksheet, Tw As Worksheet
Application.ScreenUpdating = False
Set Tw = ThisWorkbook.Sheets(1)
Workbooks.Open "c:\users\hsv\desktop\map2.xlsx"
  With ActiveWorkbook
   For Each sh In .Sheets
    If sh.Index > .Sheets("Start").Index And sh.Index < .Sheets("Herinnering").Index Then
     MsgBox sh.Name
     sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(CDate(Tw.[g16]), Tw.[b15], Tw.[n19], Tw.[i45])
   End If
  Next sh
  .Close 1
  End With
End Sub

En ik weet zeker dat dit heel dicht bij mijn vraag zit
Ik krijg helaas een foutmelding..
En als ik in de lege factuur zie bijlage tabbladen toevoeg (Start en Herinnering) dan gaat het script wel verder maar niet met gewenst resultaalt
het is overigens helemaal niet de bedoeling dat er extra tabbladen toevoegd moeten worden aan de file facturen
Vandaar ik denk dat de vraag niet goed gesteld is

ik hoop dat met dit verhaal iets meer duidelijkheid is en dat er iemand bereidt is het op te pakken
iemand zou mij een groot plezier mee doen als er een oplossing was voor bovenstaande

Don

 

[don42]

Wie kan mij helpen ik kom er niet uit

 

[HSV]

Je opent met de code:

Workbooks.Open "d:\bewaren\facturen.xlsx"

Dat is dan het actieve werkboek.
Staan daar de bladen genaamd 'Start, blad die, blad zoveel, Herinnering' ?
Volgens mij niet.

 

[don42]

HSV
Het klopt zoals je zegt, ik heb een file die heet bv maart.xlsm
het eerste tabblad is debiteuren dan Start en dan Herinnering iedere keer komt een factuur tussen beide te staan
nu wil ik dus een aparte file zoals in #28. Die van elke rekening de 4 gegevens keurig op een rij in de file facturen zet.

 

[HSV]

Schrijf hier nu eens netjes wat je van plan bent.
Bestand in #17 ?????
Ik ben alleen al aan het worstelen om je tekst te begrijpen.

 

[don42]

het moet natuurlijk #28 zijn jouw laatste bericht
sorry ben al blij dat je mij wilt helpen en dan maak ik het alleen maar ingewikkelder

foutmelding:

Als ik nu in de file facturen een tabblad start en een tabblad herinnering maak gaat het script verder.
dat is toch heel vreemd
heb in de file facturen maar èèn tabblad dit ook facturen heet

veder:
als ik (heb van alles getest ) van With ActiveWorkbook >With ThisWorkbook maak
laat MsgBox sh.Name alle namen van de facturen zien

 

[HSV]

Ik denk dat je het beste de twee bestanden maar moet plaatsen.
Schrijf erbij van welk bestand naar welk bestand geschreven moet worden.

 

[don42]

bestand1

Bekijk bijlage maart.xlsb
bestand 2 Bekijk bijlage facturen.xlsx

heb deze bestandjes behoorlijk ingekort andes krijg ik ze niet geplaats
in het eerste bestand staat de code in tabblad Deb.nr commandbutton2
het tweede bestandje is het bestand factuur wat in mijn map d:\bewaren staat
je kunt op de laatste factuur gaan staan (voor tabblad Herinnering) en via Nieuwe factuur aan paar facturen aan maken
klanten kiezen via selectie cel N2
het is enkel de bedoeling dat op het einde van een maand via tabblad Debnr de rekeningen (4 waardes naar de file facturen word gekopieerd)
dan hernoem ik de file en klik op tabbladen verwijderen om met een lege maand verder te kunnen
hoop dat het een beetje duidelijk is

Kort. de cellen G16 - B15 -N19 en I45 van elk tablad tussen Start en Herinnering (van file maart16.xlsm)
kopieren in een rij naar file facturen (tabblad facturen)
dat zullen dan ongeveer 60 regels worden

 

[HSV]

Test het zo maar eens.

Private Sub CommandButton2_Click()
Dim sh As Worksheet
Application.ScreenUpdating = False
Workbooks.Open "d:\bewaren\facturen.xlsx"
  With ThisWorkbook
   For Each sh In .Sheets
    If sh.Index > .Sheets("Start").Index And sh.Index < .Sheets("Herinnering").Index Then
     Workbooks("facturen.xlsx").Sheets("facturen").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Array(sh.[g16], CDate(sh.[b15]), sh.[n19], CCur(sh.[i45]))
   End If
  Next sh
  End With
 Workbooks("facturen.xlsx").Close 1
End Sub

 

[don42]

Geweldig
precies wat ik graag wou, werkt super
heel erg bedankt voor je hulp
ben hier echt blij mee :thumb:
Don