DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub CSV_()
With ActiveSheet
Open "c:\report.csv" For Output As #1
For i = 1 To .[a10000].End(3).Row
Write #1, .Cells(i, 1), .Cells(i, 2), .Cells(i, 3)
Next
Close #1
End With
End Sub
Sub CSV_2()
Dim arr(1 To [COLOR=Blue][B]3[/B][/COLOR]), d$, i&, j%
With ActiveSheet
Open "c:\report.csv" For Output As #1
For i = 1 To .[a10000].End(3).Row
For j = 1 To UBound(arr)
arr(j) = .Cells(i, j)
Next
d = Join(arr, ",")
Print #1, d
Next
Close #1
End With
End Sub
[FONT="Trebuchet MS"]Sub ExportRange()
Dim Filename$, NumRows&, NumCols%, r&, c%, Data
Dim ExpRng As Range
Set ExpRng = Application.Intersect(Selection, ActiveSheet.UsedRange)
NumCols = ExpRng.Columns.Count
NumRows = ExpRng.Rows.Count
Filename = ThisWorkbook.Path & "\Rky.csv"
Open Filename For Output As #1
For r = 1 To NumRows
For c = 1 To NumCols
Data = ExpRng.Cells(r, c).Value
If IsNumeric(Data) Then Data = Val(Data)
If IsEmpty(ExpRng.Cells(r, c)) Then Data = ""
If c <> NumCols Then
Write #1, [COLOR="Red"]Format$(CStr(Data), "0000 0000000");[/COLOR]
Else
Write #1, [COLOR="red"]Format$(CStr(Data), "0000 0000000")[/COLOR]
End If
Next c
Next r
Close #1
MsgBox ExpRng.Count & " cells were exported to " & Filename, vbInformation
End Sub[/FONT]
[FONT="Trebuchet MS"]Sub Emre()
For i = 1 To Range("A65536").End(3).Row
Cells(i, 1) = Replace(Cells(i, 1), " ", "")
Next i
End Sub[/FONT]
MerhabaSn.mersilen yapmış olduğun dosyanın bir örneğini bizimle de paylaşabilir misin bende çok araştırmıştım ama ne yazık ki bulamamıştım eğer çalışırsa çok işime yarayacak. Google drive de paylaşırsan sevinirim. şimdiden teşekkürler.