Ik heb een vraag over een VBA

[Edbrug]

Beste Excel leden,

Ik heb een VBA die ik op 2 werkbladen wil laten werken ik heb een VBA waar ik een formule heb bijgeschreven maar ik kom er niet verder mee.

Sub VenA()
ActiveSheet.Unprotect
  With Sheets("Offerteboeking").ListObjects(1)
    .ListRows.Add
    .DataBodyRange.Cells(.ListRows.Count, 1).Resize(, 7) = Array([D34].Value, [D33].Value, [D35].Value, [H23].Value, [B23].Value, [E31].Value, [C29].Value)    
  End With
  t = Range("D34")
  Range("B23,C24,B25,B26,D35,H33:H34,H23,H24,H25,H26,A38:I76").ClearContents
  Range("D34") = t + 1  
  End  
  Sheets("begroting").Select
  Range("A23:A29,A32:A69,I23:I29,I32:I69").ClearContents
  Sheets("Startofferte").Select  
  ActiveSheet.Protect  
End Sub

 

[Edbrug]

Sorry ik vergat erbij te schrijven wat ik erbij heb geschreven, het stuk er onder (End)

 

[Haije]

Excuus, maar wat is nu de vraag?
En waarom post je niet het bestand waar die code in voorkomt?

 

[Edbrug]

Beste Haije,

Hierbij de code waarin het rode gedeelte is wat ik erbij zou willen hebben.

Sub VenA()
ActiveSheet.Unprotect
  With Sheets("Offerteboeking").ListObjects(1)
    .ListRows.Add
    .DataBodyRange.Cells(.ListRows.Count, 1).Resize(, 7) = Array([D34].Value, [D33].Value, [D35].Value, [H23].Value, [B23].Value, [E31].Value, [C29].Value)    
[COLOR="#FF0000"]  End With
  t = Range("D34")
  Range("B23,C24,B25,B26,D35,H33:H34,H23,H24,H25,H26,A38:I76").ClearContents
  Range("D34") = t + 1  
 [COLOR="#FF0000"] End  
  Sheets("begroting").Select
  Range("A23:A29,A32:A69,I23:I29,I32:I69").ClearContents
  Sheets("Startofferte").Select [/COLOR]
  ActiveSheet.Protect  
End Sub

 

[Edbrug]

Ik krijg de tekst niet rood wat ik erbij wil hebben?

 

[VenA]

Er wordt ook gevraagd om een voorbeeldbestand. Mag je onderhand wel weten.

 

[Edbrug]

Sorry Ik ga hem even samenstellen

 

[Edbrug]

Vraag over een VBA

Hierbij het bestand

 

[VenA]

Je maakt er wel een beetje een puinhoop van. Je hebt vier modules in twee van deze modules komt een Sub VenA voor. Dus leg even uit wat de bedoeling is. Je 'knalt' hier wat neer zonder duidelijke vraag en hoopt dat wij het voor je gaan uitzoeken? Daarnaast zijn de cellen die van belang zijn leeg en mogen we eerst zelf even invullen om de code te testen?

 

[Edbrug]

VenA
Er zit nog een stuk facturatie aan de site vast waarin ik ook de sub VenA gebbruikt(dit werkt uitstekend) nog bedankt hiervoor.
Wat ik graag zou willen is als ik het blad startbegroting de sub boekenbegroting gebruikt dat hij de boeking uitvoerd (dat doet hij ook als dat onderste gedeelte eruit is) maar nu zou ik graag willen dat hij ook gelijk de 2 rijen wist op de begroting. Op de begroting mogen de 2 rijen ingevuld worden.

 

[VenA]

Dit gaat wel een beetje Babylonisch worden zo. Over welke site heb je het? Er is geen blad 'startbegroting' te vinden. De sub 'boekenbegroting' is waar te vinden? De oplossing zal vast niet moeilijk zijn maar als je van alles bij elkaar raapt en eigenlijk geen idee hebt wat je aan het doen bent, geen concrete vraag kan stellen dan wordt het een lastig verhaal. Obv #1 haal de onzin over het beveiligen er eerst maar uit en de End moet ook weg. Er zijn nog wel meer verbeterpunten maar dat komt later wel.

 

[Edbrug]

Ik ga de bijlagen aanpassen mocht er niet uit komen kan ik als nog vragen over stellen in ieder geval bedankt voor de inbreng

 

[Jack Nouws]

Zoals ik er wijs uit kan zou je het zo kunnen doen.

Sub transport()
  With Sheets("START OFFERTE")
    Arr = Array(.[D34].Value, .[D33].Value, .[D35].Value, .[H23].Value, .[B23].Value, .[E31].Value, .[C29].Value)
    .Range("D34") = .Range("D34") + 1
    .Range("B23,C24,B25,B26,D35,H33:H34,H23,H24,H25,H26,A38:I76").ClearContents
  End With
  
  With Sheets("Offerteboeking").ListObjects(1)
    .ListRows.Add
    .DataBodyRange.Cells(.ListRows.Count, 1).Resize(, 7) = Arr
  End With
  
  Sheets("begroting").Range("A23:A29,A32:A69,I23:I29,I32:I69").ClearContents
End Sub

 

[HSV]

Ik heb de vraag niet gelezen, maar dit stukje kan eenvoudiger.

With Sheets("Offerteboeking").ListObjects(1)
    .ListRows.Add
    .DataBodyRange.Cells(.ListRows.Count, 1).Resize(, 7) = Arr
  End With

Zo dus.

Sheets("Offerteboeking").ListObjects(1)[COLOR=#ff0000].ListRows.Add.range.Resize(, 7) = Arr[/COLOR]

 

[Edbrug]

Bedankt Jack Nouws, Het werkt perfect!!