csv kaydetme

[incsoft]

Arkadaşlar bir formumda istenilen alanları otomatik olarak csv kaydettirmek istiyorum .Bazı macrolar denedim ancak başaramadım.Bu konuda yardımlarınıza ihtiyacım var.

Teşekkürler.

 

[incsoft]

Arkadaşlar A1123 standart değildir data kısmındaki değerlere göre A172,A1500 olabilmektedir.Macro sadece dolu olan kısımları tespit ederek csv olarak kaydedecek.

 

[halit3]

Kod:

Sub sectigim_alanı_kayitet()

Application.ScreenUpdating = False
Application.EnableEvents = False
Klasor = ThisWorkbook.Path
If Right(Klasor, 1) <> "\" Then Klasor = Klasor & "\"

son = Sheets("DATA").Cells(Rows.Count, 1).End(xlUp).Row * 3

adres = Range("A1:D" & son).Address 'ActiveWindow.RangeSelection.Address
If InStr(Trim(adres), ":") = 0 Then Exit Sub
ThisWorkbook.Sheets(ActiveSheet.Name).Range(adres).Copy
Workbooks.Add
Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
yer = Klasor & "Sure " & Format(Now, "dd-mm-yy h-mm-ss")

If CreateObject("Scripting.FileSystemObject").FileExists(yer) = True Then
MsgBox " Bu isimde bir dosya var"
Application.DisplayAlerts = False
ActiveWindow.Close
Else

ActiveWorkbook.SaveAs yer, FileFormat:=6
ActiveWorkbook.Close SaveChanges:=False
MsgBox yer & " Dosya kayıt edildi"
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[incsoft]

Öncelikle yardımınız için teşekkür ederim.Ancak aktarmada bir sorun var efendim.Aktarma sonrasında istediğim şekilde oluşturmuyor sayfayı.Ek'te hatalı attığı şeklini ve istemiş olduğum şeklini detaylı şekilde gösterdim.Birde aktarma sonrasında soru sormadan SÜRE AKTARMA sayfasına kaydet diyerek kapatma komutu verebilirmiyiz?

Teşekkürler.

Kod:

Sub sectigim_alanı_kayitet()

Application.ScreenUpdating = False
Application.EnableEvents = False
Klasor = ThisWorkbook.Path
If Right(Klasor, 1) <> "\" Then Klasor = Klasor & "\"

son = Sheets("DATA").Cells(Rows.Count, 1).End(xlUp).Row * 3

adres = Range("A1:D" & son).Address 'ActiveWindow.RangeSelection.Address
If InStr(Trim(adres), ":") = 0 Then Exit Sub
ThisWorkbook.Sheets(ActiveSheet.Name).Range(adres).Copy
Workbooks.Add
Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
yer = Klasor & "Sure " & Format(Now, "dd-mm-yy h-mm-ss")

If CreateObject("Scripting.FileSystemObject").FileExists(yer) = True Then
MsgBox " Bu isimde bir dosya var"
Application.DisplayAlerts = False
ActiveWindow.Close
Else

ActiveWorkbook.SaveAs yer, FileFormat:=6
ActiveWorkbook.Close SaveChanges:=False
MsgBox yer & " Dosya kayıt edildi"
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[halit3]

Dosyanın içine yazdığınız mesaj aynen şöyle

ARKADAŞLAR BU SAYFADA DOLU OLAN KISIMLARI YANİ A1123 ALANINI HER SEFERİNDE KOPYALAMA YAPARAK YENİ BİR SAYFAYA SAĞ TUŞ YAPARAK ÖZEL YAPIŞTIR KISMINDAN DEĞERLERİ VE SAYIM BİÇİMLENDİRMELERİNİ DİYEREK BU DOSYAYI BİLGİSAYARIMDA BULUNAN MASAÜSTÜNE SÜRE.CSV OLARAK KAYDETMEKTEYİM.BU YAPTIĞIM İŞLEM SÜREKLİ YAPILAN BİR İŞ OLDUĞUNDAN DOLAYI ZAMAN KAYBINI ORTADAN KALDIRMAK İÇİN BUNU EXCEL DE BİR BUTONA KOD YAZARAK OTOMATİK OLARAK YAPTIRMAK İSTİYORUM.BUNUN İÇİN NASIL BİR KOD ÖNERİRSİNİZ?

Buradan şu anlamı çıkartıyorum masa üstüne süre.csv dosyası olarak kayıt etmek bende kayıtı dosyanın hemen yanına kayıt yapmak bu kayıta da tarih ve saat ekledim çünkü aynı dosya üst üste gelmemesi için.

Diğer taraftan gönderdiğiniz dosya şifreli ben şifreli konu ve dosyalara cevap vermiyorum. Size iyi çalışmalar.

 

[incsoft]

Kusura bakmayın efendim dosyanın şifresini 2.gönderimimde kaldırmayı unutmuşum.Bu dosyayı işletmemde kullandığımdan dolayı herkes tarafından kullanılmaması için şifrelemiştim.Şifresini kaldırdım.

Teşekkürler.

Dosyanın içine yazdığınız mesaj aynen şöyle


Buradan şu anlamı çıkartıyorum masa üstüne süre.csv dosyası olarak kayıt etmek bende kayıtı dosyanın hemen yanına kayıt yapmak bu kayıta da tarih ve saat ekledim çünkü aynı dosya üst üste gelmemesi için.

Diğer taraftan gönderdiğiniz dosya şifreli ben şifreli konu ve dosyalara cevap vermiyorum. Size iyi çalışmalar.

 

[incsoft]

Buna bir çözümmü yokmu arkadaşlar?

 

[incsoft]

Arkadaşlar bunu yapamadım bir türlü...