2011-10-28 108 views
2

我不知道VBA,但我需要編寫一個宏來優化我的工作。 我正在尋找我的代碼來遍歷文件,並從每個文件複製/粘貼相同的列到Excel工作簿(逐列)。這是我到目前爲止(請注意,我把文件名中的「i」):Excel宏:for循環文件到文件

Sub NewMacro() 

For i = 0 To 99 

    Workbooks.OpenText Filename:= _ 
     "C:\User\Folder\file_up000i.txt", _ 
     Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
     xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ 
     Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
     TrailingMinusNumbers:=True 
    Range("A3").Select 
    Selection.Copy 
    With ActiveWindow 
     .Top = 6.25 
     .Left = 53.5 
    End With 
    Windows("Book1").Activate 
    With ActiveWindow 
     .Top = 40.75 
     .Left = 13 
    End With 
    Range("B1").Select 
    ActiveSheet.Paste 
    Windows("file_up000i.txt").Activate 
    Range("C26").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Windows("Book1").Activate 
    Range("B2").Select 
    ActiveSheet.Paste 
    Windows("file_up000i.txt").Activate 
    With ActiveWindow 
     .Top = 4 
     .Left = -75.5 
    End With 
    ActiveWindow.Close 

    Next i 

End Sub 

顯然,這不工作,但我不知道是怎麼回事去做。非常感謝你的幫助!

+1

哪裏從第二次及以後的文件粘貼的內容去?你的文件是否都以零填充數字命名?是第10個文件名file_up00010.txt或file_up0010.txt? –

+0

除Tim的查詢之外,爲什麼您要在99個文件名中進行硬編碼 - 如果這些文件不全都存在,代碼將會崩潰,或者如果存在超過99個文件,則代碼將不完整。我建議使用'Dir'來獲取可變數量文件的相關名稱,如果順序很重要,可以對其進行排序。 – brettdj

回答

3

假設您的文件被命名爲file_up0000.txtfile_up0001.txt ... file_up0099.txt這裏的重構宏

Sub NewMacro() 
    Dim i As Long 
    Dim shTxt As Worksheet 
    Dim shDest As Worksheet 
    Dim TxtName As String 

    Set shDest = ActiveSheet 
    For i = 0 To 99 
     TxtName = "file_up" & Format(i, "0000") 
     Workbooks.OpenText Filename:= _ 
      "C:\User\Folder\" & TxtName & ".txt", _ 
      Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
      xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ 
      Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
      TrailingMinusNumbers:=True 

     Set shTxt = Workbooks(TxtName & ".txt").Worksheets(TxtName) 

     shTxt.[A3].Copy shDest.[B1] 
     shTxt.Range(shTxt.[C26], shTxt.Range("C26").End(xlDown)).Copy shDest.[B2] 
     shTxt.Parent.Close False 
    Next i 

End Sub