register313

回復 9# an13755
回復 9# GBKEE

GBKEE第一版
FileFormat:=xlText 改為 FileFormat:=xlTextPrinter  (另儲TXT檔 改另儲PRN檔)
但PRN檔每一列超過240字元(好像)就會自動換行

1. Option Explicit
   
2. Sub ZZ()
   
3.     Dim Rng As Range, i As Integer
   
4.     Application.ScreenUpdating = False
   
5.     For i = 1 To 50
   
6.         ' i 是數字        ->Sheets(i)   活頁簿視窗上第幾個工作表
   
7.         'i & "" 變成字串  ->Sheets(& "") 工作表i
   
8.         Set Rng = Sheets(i & "").Range("A1:A20")  'Rng設定為 工作表i的範圍
   
9.         With Workbooks.Add(1)                     '新增活頁簿(工作表1張)
   
10.             Rng.Copy .Sheets(1).Cells(1)          '複製到新增活頁簿第1 張工作表的[A1]
    
11.             .SaveAs Filename:="D:\" & i & ".txt", FileFormat:=xlTextPrinter, CreateBackup:=False
    
12.             .Close True
    
13.     End With
    
14.     Next i
    
15.     Application.ScreenUpdating = True
    
16. End Sub

複製代碼

an13755

g大師您好

您幫了小女子1個大忙,讓我節省不少時間

還細心的編寫註解,指導晚輩

生命中多了些許的時間可以運用

都要感謝您的幫忙,謝謝!!

還有r大師l大師也感謝你們的幫忙

r大師最後的程式也可以,謝謝!!

PJChen

大大您好,
我看了這個發表想到自己有一個類似的問題,不知能否接著發問?我錄製巨集想從excel sheet("booking")的B3:B35複製貼到TXT的筆記本中,並以sheet("booking")的A1儲存格為檔名,但巨集無法錄製,每次都只出現以下幾行?不知問題出在哪裡?可否解決?

Sub copy_to_TXT()
'
' copy_to_TXT 巨集
'

'
    Cells.Select
    Selection.Copy
End Sub

GBKEE

回復 13# PJChen
試試看

1. Sub Ex()
   
2.     Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
   
3.     Application.ScreenUpdating = False
   
4.     With Workbooks("test")                       '請改成要複製活頁簿的名稱
   
5.         Set Rng(1) = .Sheets("booking").[B3:B35]  'Rng(1) 工作表要複製的範圍
   
6.         Set Rng(2) = .Sheets("booking").[A1]      'Rng(2) 存檔名稱的儲存格
   
7.     End With
   
8.     Set Fs = CreateObject("Scripting.FileSystemObject")        'FileSystemObject 物件 提供對電腦檔案系統的存取。
   
9.     Set A = Fs.CreateTextFile("D:\" & Rng(2) & ".txt", True)   '建立文字檔案
   
10.     'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
    
11.     '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
    
12.     For Each E In Rng(1)                          '依序處裡複製範圍的儲存格
    
13.         A.WriteLine (E)                           '儲存格寫入文字檔
    
14.     Next
    
15.     A.Close
    
16.     Application.ScreenUpdating = True
    
17. End Sub

複製代碼

PJChen

GBKEE大大您好,
我的檔案位置及名稱如下P:\BCM\2011 Shipping for NE.xlsx所以我把它改成   With Windows("P:\BCM\2011 Shipping for NE.xlsx\ Workbooks(Booking") ,執行到第04行出了問題,可以幫我看看哪裡改錯了嗎?

GBKEE

回復 15# PJChen
With Workbooks("test")        '請改成要複製活頁簿的名稱   
這檔案已經開啟           With Workbooks("2011 Shipping for NE.xlsx")
這檔案尚未經開啟       With Workbooks.Open("P:\BCM\2011 Shipping for NE.xlsx")

PJChen

不好意思,執行還是有問題,請大師幫忙看看:
    Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
    Application.ScreenUpdating = False
    With Workbooks("2011 Shipping for NE.xlsx")  '請改成要複製活頁簿的名稱(已經打開)
        Set Rng(1) = .Sheet("Booking").[B3:B35]   '這裡就執行不下了
        Set Rng(2) = .Sheet("Booking").[A1]      'Rng(2) 存檔名稱的儲存格
    End With
    Set Fs = CreateObject("Scripting.FileSystemObject")        'FileSystemObject 物件 提供對電腦檔案系統的存取。
    Set A = Fs.CreateTextFile("P:\BCM\Shipping Doc\PJ\HK Packing\" & Rng(2) & ".txt", True)   '建立文字檔案
    'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
    '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
    For Each E In Rng(1)                          '依序處裡複製範圍的儲存格
        A.WriteLine (E)                           '儲存格寫入文字檔
    Next
    A.Close
    Application.ScreenUpdating = True

GBKEE

回復 17# PJChen
14# 有錯 已更正為
Set Rng(1) = .SheetS("Booking").[B3:B35]

PJChen

大師您好,
    For Each E In Rng(1)
        A.WriteLine (E)                           '執行到這裡就停了,請幫幫我
    Next
    A.Close
    Application.ScreenUpdating = True
   
End Sub

GBKEE

回復 19# PJChen
傳上檔案看看