• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Een nieuw bestand maken om bepaalde regels in te kopiëren

Status
Niet open voor verdere reacties.
E

ErwindeK

Gebruiker
Lid geworden
17 mei 2014
Berichten
12
Om data aan te kunnen leveren aan de boekhouder wil ik een macro schrijven die bepaalde regels selecteert (uit een beplaade periode) waarna die deze vervolgens kopieert in een ander bestand die zowel als CSV en XLS dient worden opgeslagen. dit bestand kan dan naar de boekhouder worden gemaild. Ik heb tot nu toe dit geschreven maar krijg steeds een foutmelding (400). Wat doe ik fout?

Code: 
Sub Kwartaalrapportereninkoopfacturen()
Dim RngHD As Range
On Error GoTo Errorcatch
Dim variabele As String
variabele = InputBox("Welk kwartaal wil je rapporteren geef een getal in van 1 t/m 4")
Select Case variabele
Case 1
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("1" _
        , "2", "3"), Operator:=xlFilterValues
        
Set NewBook = Workbooks.Add
With NewBook
    .Title = "Inkoopfacturen_Bank"
    .Subject = "Kwartaal1"
    .SaveAs Filename:="FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx"
End With

    
Windows("Aanleveren-in-verkoopfacturen.xlsm").Activate
Sheets("Inkoopfacturen").Activate
Sheets("Inkoopfacturen").Range("$A$1:$O$4870").Copy
Windows("FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx").Activate
Sheets("Blad1").Range("A1").Select
  ActiveSheet.Paste Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  
Columns("G:G").Select
Application.CutCopyMode = False
Selection.NumberFormat = "dd/mm/yyyy"
Columns("K:N").Select
Selection.Style = "Currency"
MsgBox ("Sla dit bestand op als CSV (gescheiden door komma's) en sla op in Dropbox")
ActiveWorkbook.SaveAs
 
De andere cases zijn nog niet ingevuld, wil me eerst concentreren op case 1, dan lukt de rest ook.

Code: 
Sub Kwartaalrapportereninkoopfacturen()
Dim RngHD As Range
On Error GoTo Errorcatch
Dim variabele As String
variabele = InputBox("Welk kwartaal wil je rapporteren geef een getal in van 1 t/m 4")
Select Case variabele
Case 1
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("1" _
        , "2", "3"), Operator:=xlFilterValues
        
Set NewBook = Workbooks.Add
With NewBook
    .Title = "Inkoopfacturen_Bank"
    .Subject = "Kwartaal1"
    .SaveAs Filename:="FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx"
End With

    
Windows("Aanleveren-in-verkoopfacturen.xlsm").Activate
Sheets("Inkoopfacturen").Activate
Sheets("Inkoopfacturen").Range("$A$1:$O$4870").Copy
Windows("FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx").Activate
Sheets("Blad1").Range("A1").Select
  ActiveSheet.Paste Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  
Columns("G:G").Select
Application.CutCopyMode = False
Selection.NumberFormat = "dd/mm/yyyy"
Columns("K:N").Select
Selection.Style = "Currency"
MsgBox ("Sla dit bestand op als CSV (gescheiden door komma's) en sla op in Dropbox")
ActiveWorkbook.SaveAs


Case 2
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("4" _
        , "5", "6"), Operator:=xlFilterValues

Case 3
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("7" _
        , "8", "9"), Operator:=xlFilterValues
Set NewBook = Workbooks.Add
    With NewBook
        .Title = "Inkoopfacturen Bank"
        .Subject = "Kwartaal 3 "
        .SaveAs Filename:="FS BV Q3 " & Year(Now) & " Inkoopfacturen bank .xlsx"
    End With
Case 4
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("10" _
        , "11", "12"), Operator:=xlFilterValues
        
Set NewBook = Workbooks.Add
    With NewBook
        .Title = "Inkoopfacturen Bank"
        .Subject = "Kwartaal 4 "
        .SaveAs Filename:="FS BV Q4 " & Year(Now) & " Inkoopfacturen bank .xlsx"
    End With
Case Else
MsgBox "foutieve invoer: het getal lag niet tussen de 1 en de 4!", vbCritical + vbOKOnly
End
End Select
Exit Sub

Errorcatch:
MsgBox Err.Description
End Sub
 
Heb je al gekeken op de pagina waar ik naar verwees? Dat is eerst het belangrijkste.
 
Ok. Haal dan die Errorcatch er eens uit zodat je kan zien op welke regel de fout zich voordoet.
 
Vanaf deze regel gaat hij naar Errorcatch

Code: 
Sheets("Blad1").Range("A1").Paste Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Error Catch geeft dat: "De eigenschap of methode wordt niet ondersteund door dit object."
 
Dat is dan vreemd want die regel komt niet voor in de routine die je plaatste.
 
Ik ben ondertussen ook wat dingen aan t proberen natuurlijk dus deze kan net ietsje anders zijn dan de eerste die ik plaatste maar het gaat om het [CODE
Sub Kwartaalrapportereninkoopfacturen()
Dim RngHD As Range
On Error GoTo Errorcatch
Dim variabele As String
variabele = InputBox("Welk kwartaal wil je rapporteren geef een getal in van 1 t/m 4")
Select Case variabele
Case 1
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("1" _
, "2", "3"), Operator:=xlFilterValues

Set NewBook = Workbooks.Add
With NewBook
.Title = "Inkoopfacturen_Bank"
.Subject = "Kwartaal1"
.SaveAs Filename:="FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx"
End With


Windows("Aanleveren-in-verkoopfacturen.xlsm").Activate
Sheets("Inkoopfacturen").Activate
Sheets("Inkoopfacturen").Range("$A$1:$O$4870").Copy
Windows("FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx").Activate
hier gaat het misSheets("Blad1").Range("A1").Paste Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Columns("G:G").Select
Application.CutCopyMode = False
Selection.NumberFormat = "dd/mm/yyyy"
Columns("K:N").Select
Selection.Style = "Currency"
MsgBox ("Sla dit bestand op als CSV (gescheiden door komma's) en sla op in Dropbox")
ActiveWorkbook.SaveAs


Case 2
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("4" _
, "5", "6"), Operator:=xlFilterValues

Case 3
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("7" _
, "8", "9"), Operator:=xlFilterValues
Set NewBook = Workbooks.Add
With NewBook
.Title = "Inkoopfacturen Bank"
.Subject = "Kwartaal 3 "
.SaveAs Filename:="FS BV Q3 " & Year(Now) & " Inkoopfacturen bank .xlsx"
End With
Case 4
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("10" _
, "11", "12"), Operator:=xlFilterValues

Set NewBook = Workbooks.Add
With NewBook
.Title = "Inkoopfacturen Bank"
.Subject = "Kwartaal 4 "
.SaveAs Filename:="FS BV Q4 " & Year(Now) & " Inkoopfacturen bank .xlsx"
End With
Case Else
MsgBox "foutieve invoer: het getal lag niet tussen de 1 en de 4!", vbCritical + vbOKOnly
End
End Select
Exit Sub

Errorcatch:
MsgBox Err.Description
End Sub





[/CODE]
 
Er ging ook iets mis met je codetags ;)
 
hahaha ja volgens mij komt t helemaal nergens meer goed mee.. Let's call it a day.. Misschien dat iemand anders hier nog een geniale ingeving krijgt om te zien wat hier mis gaat. Thanks iig voor je hulp!
 
Weizih dit stukje:
Code: 
ActiveSheet.Paste Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

eens in dit:
Code: 
ActiveSheet.PasteSpecial Paste:=xlPasteValues , Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
Laatst bewerkt:
Krijg dan "Methode select van klasse range is mislukt" en ik heb sowieso nodig dat er alleen waardes worden geplakt...
 
Uiteraard, maar dat is dan van later zorg. Haal die $ tekens eens uit :$O$4870
Ik moet helaas nu zelf weg.
 
Hoe bedoel je, alles moet geplakt worden? Ik kan toch alleen waarde plakken..?
 
Klopt, dat had ik al aangepast in m'n vorige bericht ;)
 
Hij doet t, dit is de code geworden. Thanks voor je hulp

Code: 
Sub Kwartaalrapportereninkoopfacturen12()
Dim RngHD As Range
On Error GoTo Errorcatch
Dim variabele As String
variabele = InputBox("Welk kwartaal wil je rapporteren geef een getal in van 1 t/m 4")
Select Case variabele
Case 1
Sheets("Inkoopfacturen").Range("A1:O4870").AutoFilter Field:=4, Criteria1:=Array("1" _
        , "2", "3"), Operator:=xlFilterValues
        
Set NewBook = Workbooks.Add
With NewBook
    .Title = "Inkoopfacturen_Bank"
    .Subject = "Kwartaal1"
    .SaveAs Filename:="FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx"
End With

    
Windows("Aanleveren-in-verkoopfacturen.xlsm").Activate
Sheets("Inkoopfacturen").Activate
Sheets("Inkoopfacturen").Range("A1:O4870").Copy
Windows("FS BV Q1 " & Year(Now) & " Inkoopfacturen bank .xlsx").Activate
Range("A1:O4870").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Range("a1").Select
Columns("G:G").NumberFormat = "dd/mm/yyyy"
Columns("K:K").Style = "Currency"
Columns("L:L").Style = "Currency"
Columns("M:M").Style = "Currency"
Columns("N:N").Style = "Currency"
MsgBox ("Sla dit bestand op als CSV (gescheiden door komma's) en sla op in Dropbox")


Case 2
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("4" _
        , "5", "6"), Operator:=xlFilterValues

Case 3
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("7" _
        , "8", "9"), Operator:=xlFilterValues
Set NewBook = Workbooks.Add
    With NewBook
        .Title = "Inkoopfacturen Bank"
        .Subject = "Kwartaal 3 "
        .SaveAs Filename:="FS BV Q3 " & Year(Now) & " Inkoopfacturen bank .xlsx"
    End With
Case 4
Sheets("Inkoopfacturen").Range("$A$1:$Q$4870").AutoFilter Field:=4, Criteria1:=Array("10" _
        , "11", "12"), Operator:=xlFilterValues
        
Set NewBook = Workbooks.Add
    With NewBook
        .Title = "Inkoopfacturen Bank"
        .Subject = "Kwartaal 4 "
        .SaveAs Filename:="FS BV Q4 " & Year(Now) & " Inkoopfacturen bank .xlsx"
    End With
Case Else
MsgBox "foutieve invoer: het getal lag niet tussen de 1 en de 4!", vbCritical + vbOKOnly
End
End Select
Exit Sub

Errorcatch:
MsgBox Err.Description
End Sub
 
Je was me voor :)
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan