Opslaan als CSV

[bgerco]

Hallo,

Ik heb een bestand waarbij ik meerdere werkbladen heb. Ik wil een knop invoeren met een macro erachter dat als ik op de knop klik alleen het werkblad "x" opgeslagen wordt als .csv in een bepaalde map op de G schijf (en is het hier ook mogelijk om de bestandsnaam door een celwaarde te laten bepalen, bijvoorbeeld bestandsnaam =B18?. Alleen dat ene werkblad "x" en het is van belang dat het gescheiden wordt door een komma en niet door puntkomma.

Wie kan mij helpen?

 

[Ginger]

Bgerco, Plaats deze code....

Sub SlaOpAlsCSV()
Dim sNieuweNaam As String

    sNieuweNaam = ActiveWorkbook.Path & "\" & Sheets("x").Range("B18").Value
    
    Sheets("x").Copy
    ActiveWorkbook.SaveAs Filename:=sNieuweNaam, FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False

    MsgBox "Sheet is opgeslagen met workbookname: " & sNieuweNaam

End Sub

...maar 'ns in een module van je VBE. Maak een knop aan in je workbook en koppel de code. Verander eventueel de 'x' (staat er 2 keer in!!!!) in de code voor de echte naam van de sheet die je wilt wegschrijven.

Let op! Dit is code 'uit de losse pols'. Er is dus geen enkele vorm van foutafhandeling (en er zijn best een paar puntjes waar het op fout kan lopen...)

Groet, Leo

 

[hackerfrans]

Niet om eerder voorbeeld af te keuren, maar meer een alternatief.
(laat gebruiker zelf het splitsteken kiezen, geen idee of het in recentere excel ook werkt)

Sub SlaOpAlsCSV();

Dim objBereik As Object, DoelRij As Object, Cel As Object
Dim strTemp As String
Dim strDataNaam As String
Dim strKoppelteken As String
Dim strMapPad As String

strMapPad = "G:\" & ActiveSheet.Range("B18").Value & ".csv"

strDataNaam = InputBox("Naam voor de CSV data (incl. Pad)?", "CSV-Export", strMapPad)
If strDataNaam = "" Then Exit Sub

strKoppelteken = InputBox("Welk splitsteken zal gebruikt worden?", "CSV-Export", ",")
If strKoppelteken = "" Then Exit Sub

Set objBereik = ActiveSheet.UsedRange

Open strDataNaam For Output As #1

For Each DoelRij In objBereik.Rows
For Each Cel In DoelRij.Cells
If InStr(1, Cel.Text, strKoppelteken) > 0 Then
'Cellen met splitsteken in rij zetten
strTemp = strTemp & """" & CStr(Cel.Text) & """" & strKoppelteken
Else
strTemp = strTemp & CStr(Cel.Text) & strKoppelteken
End If
Next
If Right(strTemp, 1) = strKoppelteken Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereik = Nothing
MsgBox "Data geexporteerd naar" & vbCrLf & strDataNaam

End Sub

 

[bgerco]

Hackerfrans

Hackerfrans,

Jou oplossing komt het dichste bij wat ik wil. Ik heb alleen nog 1 vraag. het werkt namelijk goed, maar hij pakt nu telkens het werkblad waar ik in sta, maar wat ik wil is door op een druk op de knop in een werkblad een ander werkblad opslaan als CSV bestand. Dat werkblad heet Gurbesoft en het werkblad waar de knop zich bevind heet keuze.

Kun je me daar nog mee verder helpen?

 

[Ginger]

Bgerco, Prima dat je geholpen bent met de oplossing van hackerfrans maar ik snap ff niet waarom het moeilijker moet dan noodzakelijk. Mijn code copieert de sheet en slaat 'm direct op als .csv-bestand (dus door het juiste fileformat te kiezen wordt iedere cel automatisch door een komma gescheiden). Hiermee hoef je dus niet door de cellen heen te lussen en heb je letterlijk alles wat er op je sheet staat.

Groet, Leo


EDIT: Hmmm... dit klinkt nogal 'jaloers'... Maar dat is het zeker niet! Slechts gewoon een opmerking.

 

[hackerfrans]

In dat geval in mijn eerder gegeven script op regel 17 ActiveSheet te vervangen door:

Sheets("Gurbesoft")

Alleen weet ik niet van welke sheet je B18 in de bestandsnaam wilt hebben. Als dat al goe dwas, dan regel 9 laten staan en anders op dezelfde manier aanpassen.

 

[bgerco]

Het werkt goed, alleen 1 probleem. Als ik het nu opsla (zie bijlage voor CSV bestand)

Dan krijg ik teveel extra komma's. Ik moet alleen de cellen hebben die ik gebruik en niet de tussenliggende. De functie Set objBereik = Sheets("Gurbesoft").UsedRange moet anders, maar ik weet niet hoe.

Kan iemand mij hier nog verder mee helpen??

PROBLEEM bijna opgelost!

 

[bgerco]

Help!

 

[hackerfrans]

Aanpassing die lege rijen en cellen overslaat:

For Each DoelRij In Bereik.Rows
For Each Cel In DoelRij.Cells
If Not IsEmpty(Cel.Value) Then
If InStr(1, Cel.Text, strKoppelteken) > 0 Then
'Cellen met splitsteken in rij zetten
strTemp = strTemp & """" & CStr(Cel.Text) & """" & strKoppelteken
Else
strTemp = strTemp & CStr(Cel.Text) & strKoppelteken
End If
End If
Next
If Right(strTemp, 1) = strKoppelteken Then strTemp = Left(strTemp, Len(strTemp) - 1)
If Not (strTemp = "") Then
Print #1, strTemp
strTemp = ""
End If
Next

 

[Wigi]

Hier is ook mooie code:

http://www.cpearson.com/excel/ImpText.aspx

 

[bgerco]

Merci bien allemaal