Judithdoek
Gebruiker
- Lid geworden
- 9 mrt 2021
- Berichten
- 70
Hallo,
Bijgevoegd een bestand waarmee ik enkel het blad Formulier test2 wil opslaan, met de bestandsnaam die op blad invoerbestand test2 in cel L3 staat.
D.m.v. macro's opnemen heb ik geprobeerd de code naar mijn wens te genereren. Er gaat alleen iets mis in onderstaande code in de tekst die rood is gemaakt, waardoor het bestand niet opgeslagen kan worden.
Kan iemand mij helpen?
Bijgevoegd een bestand waarmee ik enkel het blad Formulier test2 wil opslaan, met de bestandsnaam die op blad invoerbestand test2 in cel L3 staat.
D.m.v. macro's opnemen heb ik geprobeerd de code naar mijn wens te genereren. Er gaat alleen iets mis in onderstaande code in de tekst die rood is gemaakt, waardoor het bestand niet opgeslagen kan worden.
Kan iemand mij helpen?
Code:
Option Explicit
Sub Gegevens_opslaan()
ReDim ar(1 To 1, 1 To 15)
With Sheets("Invoerbestand test2")
If .Cells(4, 2).Value = "" Then .Cells(4, 2).Value = 0
ar(1, 1) = [Nummer]
ar(1, 2) = [Naam]
ar(1, 3) = [Naam1]
ar(1, 4) = [Klant]
ar(1, 5) = [Soort_afspraak]
ar(1, 6) = [Contactpersoon]
ar(1, 7) = [Klantnummer]
ar(1, 8) = [Bedrag]
ar(1, 9) = [Plaats]
ar(1, 10) = [Groep]
ar(1, 11) = [Percentage]
ar(1, 12) = [Opmerking]
ar(1, 13) = [Percentage2]
ar(1, 14) = [Percentage3]
ar(1, 15) = [Percentage4]
.Cells(4, 2).Value = Year(Date) & "-" & Format(Int(Right(.Cells(4, 2).Value, 4)) + 1, "#0000")
End With
With Sheets("Overzicht afspraken test2")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(ar, 2)) = ar
End With
End Sub
Sub Cellen_leegmaken()
Range("D4").ClearContents
Range("F4").ClearContents
Range("B7").ClearContents
Range("D7").ClearContents
Range("F7").ClearContents
Range("B10").ClearContents
Range("D10").ClearContents
Range("F10").ClearContents
Range("B13").ClearContents
Range("D13").ClearContents
Range("F13").ClearContents
Range("B16").ClearContents
Range("D16").ClearContents
Range("F16").ClearContents
End Sub
Sub cel_plakken_als_waarde()
Range("L3").Select
Application.CutCopyMode = False
Selection.Copy
Range("L4").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L4").Select
End Sub
[COLOR="#FF0000"]Sub Specifiek_blad_opslaan()
Sheets("Formulier test2").Select
Range("A1:U258").Select 'Wat doe ik hier fout en hoe geef ik aan welk bereik ik moet selecteren?
Selection.Copy
Workbooks.Add
Application.WindowState = xlNormal
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blad1").Select
Sheets("Blad1").Name = "VMC"
Application.CutCopyMode = False
ChDir "H:\04 Visual Basic\TEST"
ActiveWorkbook.SaveAs Filename:="H:\04 Visual Basic\TEST\test1.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'bij test1 moeten de gegevens op blad invoerbestand test2 in cel L3 (of cel L4 die d.m.v. klikken op knop gegevens in L3 plakt als waarde in L4)
Windows("Specifiek blad opslaan").Activate
End Sub
[/COLOR]
Private Sub CommandButton1_Click()
Call cel_plakken_als_waarde
Call Gegevens_opslaan
Call Cellen_leegmaken
Call Specifiek_blad_opslaan
End Sub