Goedemorgen,
Ik heb de volgende code gefabriceerd om uit een ander tabblad steeds een bepaalde RANGE te kopieren en te plakken in een andere excel en deze vervolgens op te slaan als een .CSV.
Echter als ik de macro draai vraagt hij bij elke als hij de routine heeft gevolgd of ik het bestand wil opslaan, terwijl ik dit juist in mijn macro heb opgenomen. Wie heeft de oplossing voor mij...?
Ik heb de volgende code gefabriceerd om uit een ander tabblad steeds een bepaalde RANGE te kopieren en te plakken in een andere excel en deze vervolgens op te slaan als een .CSV.
Echter als ik de macro draai vraagt hij bij elke als hij de routine heeft gevolgd of ik het bestand wil opslaan, terwijl ik dit juist in mijn macro heb opgenomen. Wie heeft de oplossing voor mij...?
Code:
Sub uploader()
'++++++++++++++++++++++
'Naam: xxxxx
'Datum: 15-11-2016
'Doel: een standaard format vullen met waarden uit een bestaande sheet
'++++++++++++++++++++++
'++++++++++++++++++++++
'Dimensies definieren
'++++++++++++++++++++++
Dim VA As Variant 'geselecteerde AGB
Dim Findstring As String
Dim RNGFirst As Range
Dim RNGLast As Range
Dim RowFirst As Long
Dim RowLast As Long
Dim Copyrange As String
Dim F As String 'File locatie
'-------------------
'AGB-code selecteren
'-------------------
Sheets("lijst").Select
Cells(2, 1).Select
AV = ActiveCell.Value
If AV = "" Then GoTo 999
'-------
'Stap 0
'------------------------------------------
'Waarde uit tabblad "lijst" ophalen in cel plaatsen
'------------------------------------------
'--------------------
'Naamgeving en lokatie voor opslaan
'--------------------
1
FN = AV & ".csv"
F = Sheets("parameters").Range("B2")
Sheets("Format Oracle").Select
Range("F11") = AV
'-------
'Stap 1
'------------------------------------------
'Zoeken van code in prijslijst en gegevens selecteren
'------------------------------------------
'++++++++++++++++++++++++++++++++++++++++++++++++
'+Dimensies benoemen +
'+Uit de sheet "Format Oracle" haalt +
'+VBA de waarde die opgezocht moet worden in de +
'+sheet "Verzamelstaat 2016 in 2016 +
'++++++++++++++++++++++++++++++++++++++++++++++++
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+ code opzoeken in prijslijsten bestand +
'+ Gekozen is om de waarde als rijnummer op te halen +
'+ in de vorm van laatste en eerste waar de waarde voorkomt +
'+ Vervolgens hiervan een RANGE te maken +
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'---------|
'Findfirst|
'---------|
Findstring = AV
If Trim(Findstring) <> "" Then
With Sheets("Verzamelstaat 2016 in 2016").Range("A:A") 'voor andere jaren moet een andere sheet gemaakt worden
Set RNGFirst = .Find(What:=Findstring, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
RowFirst = RNGFirst.Row
End With
End If
'---------|
'Findlast |
'---------|
If Trim(Findstring) <> "" Then
With Sheets("Verzamelstaat 2016 in 2016").Range("A:A")
Set RNGLast = .Find(What:=Findstring, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
RowLast = RNGLast.Row
End With
End If
'-------
'Stap 2
'-----------------------------------------
'Kopieren en plakken in het format bestand
'-----------------------------------------
Copyrange = "D" & RowFirst & ":" & "O" & RowLast 'Range Definieren
Sheets("Verzamelstaat 2016 in 2016").Select
Range(Copyrange).Select
Selection.copy
Sheets("Format Oracle").Select
Range("A16").Select
Selection.Insert Shift:=xlDown
'------
'Stap 3
'--------------------------------------
'Naamgeving bestand en opslaan als .csv
'--------------------------------------
Sheets("Format Oracle").Select
Sheets("Format Oracle").copy
[I]ActiveWorkbook.SaveAs Filename:=F & FN, FileFormat:=xlCSV, Password:=P 'optioneel een password
ActiveWorkbook.Close[/I]
'------------------------------------
'Clear oude content
'------------------------------------
Windows( _
"Kopie van 20161025 Format Oracle_inventarisatie_v0.1 test 4 macro (2).xlsm"). _
Activate
Sheets("Format Oracle").Select
Range("C16").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
'--------------
'Loop instellen
'--------------
Sheets("lijst").Select
ActiveCell.Offset(1, 0).Select
AV = ActiveCell.Value
If AV <> "" Then GoTo 1
999 'Einde
MsgBox ("Klaar")
End Sub