metin dosyasindan excel dosyasina kopyalama

[ne3c9m]

merhaba,

ekteki excel dosyasina yazilacak makro ile metin dosyasindaki verileri yeni bir excel dosyasina yapistirmak istiyorum. sonrasinda ilk excel dosyasinin ve metin dosyasinin kapanmasini ve yeni excel dosyasinin ise Rapor.xls olarak masaustune kaydedilip kapatilmasini istiyorum.

konu ile ilgili yardimci olabilirseniz sevinirim.

iyi gunler.

 

[Orion1]

merhaba,

ekteki excel dosyasina yazilacak makro ile metin dosyasindaki verileri yeni bir excel dosyasina yapistirmak istiyorum. sonrasinda ilk excel dosyasinin ve metin dosyasinin kapanmasini ve yeni excel dosyasinin ise Rapor.xls olarak masaustune kaydedilip kapatilmasini istiyorum.

konu ile ilgili yardimci olabilirseniz sevinirim.

iyi gunler.

Eklenti yok.
Eklememişsiniz.

 

[ne3c9m]

uyari icin tesekkurler.

unutulan dosya ektedir...

 

[Orion1]

Dosyanız ektedir.

Sub txt_al()
Dim sh1 As Worksheet, sh2 As Worksheet, rapor As String
Dim sat As Long, Dosyaad As String
sat = 2
Set sh1 = ThisWorkbook.Sheets("Sheet1")
ThisWorkbook.Activate
sh1.Select
Range("A2:A65536").ClearContents
If Dir(ThisWorkbook.Path & "\New Text Document.txt") = "" Then
    MsgBox ThisWorkbook.Path & "\New Text Document Dosyası bulunamdı!" & _
    vbLf & "İşlem yapılamadı!", vbCritical, "UYARI"
    Exit Sub
End If
Dosyaad = "Rapor_" & Format(Now, "dd_mm_yyyy_hh_mm_ss") & ".xls"
rapor = ThisWorkbook.Path & "\" & Dosyaad
Workbooks.Add.SaveAs Filename:=rapor
Set sh2 = ActiveWorkbook.Sheets(1)
sh2.Range("A1").Value = "Text Verileri"

Open (ThisWorkbook.Path & "\New Text Document.txt") For Input As #1
Do While Not EOF(1)
    If sat > 65533 Then
        MsgBox "Sayfada satır doldu başka kayıt alınamdı", vbCritical, "UYARI"
        Exit Do
    End If
    Line Input #1, a
    sh1.Cells(sat, "A").Value = a
    sh2.Cells(sat, "A").Value = a
    sat = sat + 1
Loop
Close #1
Workbooks(Dosyaad).Close True
MsgBox "Text Dosyasından veriler çekildi.Bir yedeğide " & Dosyaad & " dosyasına çoıkarıldı" & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub