Mungkin begini :
public Sub excel2text()
'
' excel2text Macro
'
'
'Range("A2:Y16").Select ' Barisnya selalu tidak tetap
'Selection.Copy
'jadi :
dim lRows as long
lrows=worksheetfunction.counta(activesheet.range("b1").entirecolumn)
range("a2:a" & lrows).copy
'Application.CutCopyMode = False
'ChDir "G:\Project"
'Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'ActiveWindow.ScrollColumn = 2
' ActiveWindow.ScrollColumn = 3
' ActiveWindow.ScrollColumn = 4
' ActiveWindow.ScrollColumn = 5
' ActiveWindow.ScrollColumn = 6
' ActiveWindow.ScrollColumn = 7
' ActiveWindow.ScrollColumn = 6
' ActiveWindow.ScrollColumn = 5
' ActiveWindow.ScrollColumn = 4
' ActiveWindow.ScrollColumn = 3
' ActiveWindow.ScrollColumn = 2
' ActiveWindow.ScrollColumn = 1
' Rows("16:16").Select
' Range(Selection, Selection.End(xlDown)).Select
' Application.CutCopyMode = False
' Selection.Delete Shift:=xlUp
' ActiveWindow.SmallScroll Down:=-12
' Range("A7").Select
' ChDir "C:\Documents and Settings\emi_lestari\Desktop"
'ActiveWorkbook.SaveAs Filename:= _
' "C:\Documents and Settings\emi_lestari\Desktop\batch206.txt",
FileFormat _
' :=xlText, CreateBackup:=False
'ActiveWindow.Close
'jadi :
dim sFolder as string
application.displayalerts=false 'supaya Excel ndak tanya
konfirmasi
sfolder="C:\Documents and Settings\emi_lestari\Desktop\" 'jika
tetap
'atau
'sfolder=range("z1").value 'jika di cell z1
ada teks folder lokasi penyimpanan (harus diakhiri \ )
ActiveWorkbook.SaveAs sfolder & activesheet.name & ".txt",xltext
ActiveWorkbook.close false
application.displayalerts=true 'Excel diperbolehkan tanya
konfirmasi lagi (proses sudah selesai)
End Sub
Sebaiknya semua baris Dim bla-bla dikumpulkan pada baris-baris awal setelah
deklarasi nama prosedur
Wassalam,
Kid.
2012/10/29 Emi <emilestarik...@yahoo.com>
> **
>
>
> Teman dan Guru BeExcel.
> Saya mau belajar menulis makro yang benar. (Makro yg di file ini hasil
> recording)
>
> Option Explicit
> Sub excel2text()
> '
> ' excel2text Macro
> '
> '
> Range("A2:Y16").Select ' Barisnya selalu tidak tetap
> Selection.Copy
> Application.CutCopyMode = False
> ChDir "G:\Project"
> Selection.Copy
> Workbooks.Add
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :=False, Transpose:=False
> ActiveWindow.ScrollColumn = 2
> ActiveWindow.ScrollColumn = 3
> ActiveWindow.ScrollColumn = 4
> ActiveWindow.ScrollColumn = 5
> ActiveWindow.ScrollColumn = 6
> ActiveWindow.ScrollColumn = 7
> ActiveWindow.ScrollColumn = 6
> ActiveWindow.ScrollColumn = 5
> ActiveWindow.ScrollColumn = 4
> ActiveWindow.ScrollColumn = 3
> ActiveWindow.ScrollColumn = 2
> ActiveWindow.ScrollColumn = 1
> Rows("16:16").Select
> Range(Selection, Selection.End(xlDown)).Select
> Application.CutCopyMode = False
> Selection.Delete Shift:=xlUp
> ActiveWindow.SmallScroll Down:=-12
> Range("A7").Select
> ChDir "C:\Documents and Settings\emi_lestari\Desktop"
> ActiveWorkbook.SaveAs Filename:= _
> "C:\Documents and Settings\emi_lestari\Desktop\batch206.txt",
> FileFormat _
> :=xlText, CreateBackup:=False
> ActiveWindow.Close
> End Sub
>
> *Algorithm nya adalah seperti berikut.*
> 1. Select range A2:Y16 (range ini berubah ubah)
> 2. Copy, paste special value ke worksheet baru dengan "Batch206" ikut nama
> worksheetnya (juga berubah ubah)
> 3.Pada worksheet yang baru (Batch206.xlsx, cari baris akhir yang ada data.
> 4.Pada baris yang tiada data (dihighlight dengan control + shift + arrow
> down)
> 5.Delete semua baris yang kosong.
> 6.Save file as "text(Tab delimited)(*.txt) di desktop
> 7.Yes (response pada msg box)
> 8.Tutup file excel.
>
> *Masalah yang ingin dipecahkan*
> **
> 1.Bagaimana ingin menetapkan area yang akan dicopy. Jika diberi nama
> offset name range, row yang kosong tetapi ada formula akan ikut ter
> select.
> 2. Path yang di mana file mau di simpan. Kalau recoding path nya ChDir
> "C:\Documents and Settings\emi_lestari\Desktop, bagaimana supaya lebih umum
> dan bisa di gunakan oleh semua user.
> 3. Bagaimana supaya tidak keluar msg box di bawah, waktu run time, supaya
> user tidak perlu menjawab pertanyaan tersebut.
>
> Contoh file dan hasil text file yang diinginkan adalah seperti
> dilampirkan.
>
> Terima kasih
> - Emi Lestari
>
>
>
