VBA Routine: Opslaan van .CSV geeft de melding wilt u het bestand opslaan?

Status
Niet open voor verdere reacties.

Markowitz

Gebruiker
Lid geworden
5 feb 2015
Berichten
15
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...?
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
 
Ik denk dat het hiermee (in plaats van de volledige door jou geplaatste code) ook (en sneller) gaat:

Code:
Sub M_snb()
     Application.DisplayAlerts = False
     sn = Sheets("lijst").Cells(2, 1).Resize(, 20)
     
     For j = 1 To UBound(sn)
         If sn(j, 1) = "" Then Exit For
        
         With Sheets("Verzamelstaat 2016 in 2016").UsedRange
             .AutoFilter 1, sn(j, 1)
             .Copy Sheets("Format Oracle").Cells(16, 1)
             .AutoFilter
         End With
         
         With Sheets("Format Oracle")
              .Cells(11, 6) = sn(j, 1)
              .SaveAs Sheets("parameters").Range("B2") & sn(j, 1) & ".csv", 6
         End With
                 
         ActiveWorkbook.Close
    Next
 End Sub
 
Bedankt voor de code. Echter het bestaande probleem is er niet mee opgelost. Hij vraagt nog steeds of ik het bestand wil opslaan. En daarnaast doet de macro niet wat ik exact wil. Je moet namelijk in jouw macro goed bepalen dat je in het juiste tabblad start en de opdracht om het werkboek te closen doet hij ook op het werkboek welke je juist niet wilt sluiten....Maargoed dat is het probleem niet.

In ieder geval bedankt voor het proberen. Ik hou nu gewoon heeeeeeel lang mn vinger op de "O" zodat hij een buffer opslaat met de juiste opdracht...
 
Zonder geplaatst bestand is het natuurlijk alleen maar gokken: halve info: halve antwoorden.

Code:
Sub M_snb()
     Application.DisplayAlerts = False
     sn = thisworkbook.Sheets("lijst").Cells(2, 1).Resize(, 20)
     
     For j = 1 To UBound(sn)
         If sn(j, 1) = "" Then Exit For
        
         With thisworkbook.Sheets("Verzamelstaat 2016 in 2016").UsedRange
             .AutoFilter 1, sn(j, 1)
             .Copy thisworkbook.Sheets("Format Oracle").Cells(16, 1)
             .AutoFilter
         End With
         
         thisworkbook.Sheets("Format Oracle").copy
         with activeworkbook
              .sheets(1).Cells(11, 6) = sn(j, 1)
              .SaveAs thisworkbook.Sheets("parameters").Range("B2") & sn(j, 1) & ".csv", 6
              .close 0
         End With 
    Next
 End Sub

Dat je die vraag nog steeds krijgt geloof ik niet.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan