Excel 循环浏览所有工作簿和工作表，格式化并复制到模板_Excel_Vba

Excel 循环浏览所有工作簿和工作表，格式化并复制到模板

excel vba

Excel 循环浏览所有工作簿和工作表，格式化并复制到模板,excel,vba,Excel,Vba,我有一个要从中运行此代码的模板工作簿。代码是循环遍历目录中的所有文件，并循环遍历每个文件中的所有工作表。在每个工作表中，运行一个基本上格式化数据的过程，然后将粘贴复制到模板工作簿中的工作表中，在该工作表中进行更多格式化当文件中只有一个工作表时，我的这段代码可以工作，但当有多个工作表时，工作表循环会发生在模板工作簿上，而不是文件上我已将格式化代码创建为另一个要调用的宏。我尝试在格式化宏中添加工作表循环，但遇到了相同的问题选项显式子testLoopTabs（）以 ActiveSheet.P

我有一个要从中运行此代码的模板工作簿。代码是循环遍历目录中的所有文件，并循环遍历每个文件中的所有工作表。在每个工作表中，运行一个基本上格式化数据的过程，然后将粘贴复制到模板工作簿中的工作表中，在该工作表中进行更多格式化

当文件中只有一个工作表时，我的这段代码可以工作，但当有多个工作表时，工作表循环会发生在模板工作簿上，而不是文件上

我已将格式化代码创建为另一个要调用的宏。我尝试在格式化宏中添加工作表循环，但遇到了相同的问题

选项显式子testLoopTabs（）

以

ActiveSheet.Paste



'format dates and text to column
Columns("E:F").Select
Application.CutCopyMode = False
Selection.NumberFormat = "dd/mm/yyyy"
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


'find Net Value column
Dim cell As Range
Dim I As Integer
For I = 12 To 20

    If Cells(1, I).Value = "Net Amount" Then
    Columns(I).Select
    Selection.Cut
    Columns("K:K").Insert Shift:=xlToRight


    Else

    End If

Next I


'format numbers to general
Columns("H:H").Select
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


 Columns("K:K").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Columns("M:M").Select
Selection.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True



'add Other Charges

Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Other Charges"
Range("N2").Select
Application.CutCopyMode = False


    ActiveCell.FormulaR1C1 = _
    "=IF(RC[-7]=""B"",ROUND(RC[-3]-RC[-2]-RC[-1],2),ROUND(RC[-2]-RC[-3]-RC[-1],2))"

Range("N2").Select


If IsEmpty(Range("B3")) = False Then

    Range("N2").Select
    Selection.Copy

With Range("M2")
Range(.Cells(2, 2), .End(xlDown).Offset(0, 1)).Select

    ActiveSheet.Paste

Range("A2:N2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

Else

Range("A2:N2").Copy

End If



'paste to brokertradefile

wb.Worksheets("BrokerTradeFile").Activate

Range("A6").End(xlDown).Offset(1, 0).Select

ActiveSheet.Paste
Application.CutCopyMode = False

以

ActiveSheet.Paste



'format dates and text to column
Columns("E:F").Select
Application.CutCopyMode = False
Selection.NumberFormat = "dd/mm/yyyy"
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


'find Net Value column
Dim cell As Range
Dim I As Integer
For I = 12 To 20

    If Cells(1, I).Value = "Net Amount" Then
    Columns(I).Select
    Selection.Cut
    Columns("K:K").Insert Shift:=xlToRight


    Else

    End If

Next I


'format numbers to general
Columns("H:H").Select
Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


 Columns("K:K").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Columns("M:M").Select
Selection.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True



'add Other Charges

Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N1").Select
ActiveCell.FormulaR1C1 = "Other Charges"
Range("N2").Select
Application.CutCopyMode = False


    ActiveCell.FormulaR1C1 = _
    "=IF(RC[-7]=""B"",ROUND(RC[-3]-RC[-2]-RC[-1],2),ROUND(RC[-2]-RC[-3]-RC[-1],2))"

Range("N2").Select


If IsEmpty(Range("B3")) = False Then

    Range("N2").Select
    Selection.Copy

With Range("M2")
Range(.Cells(2, 2), .End(xlDown).Offset(0, 1)).Select

    ActiveSheet.Paste

Range("A2:N2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy

Else

Range("A2:N2").Copy

End If



'paste to brokertradefile

wb.Worksheets("BrokerTradeFile").Activate

Range("A6").End(xlDown).Offset(1, 0).Select

ActiveSheet.Paste
Application.CutCopyMode = False

“结束过程

wbCopy.Activate

        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        MsgBox ws.Name
    Next ws
    MsgBox wbCopy.Name
    wbCopy.Close SaveChanges:=False
    MyFile = Dir
Loop

'turns settings back on that you turned off before looping folders
MemorySave False

端接头子MemorySave（作为布尔值）

End Sub

以下是我将如何做到这一点：

Option Explicit
Sub testLoopTabs()

    Dim MyFolder As String, MyFile As String
    Dim wb As Workbook, wbCopy As Workbook
    Dim ws As Worksheet 'to loop through all the sheets

    'Opens a file dialog box for user to select a folder

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

    'stops screen updating, calculations, events, and statsu bar updates to help code run faster
    'you'll be opening and closing many files so this will prevent your screen from displaying that
    MemorySave True 'You can use this procedure instead

    'This section will loop through and open each file in the folder you selected
    'and then close that file before opening the next file

    MyFile = Dir(MyFolder & "\", vbReadOnly)
    Set wb = ThisWorkbook 'to refer to the workbook containing the code

    Do While MyFile <> ""
        Set wbCopy = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False, ReadOnly:=True)
        'loop worksheet
         ' Begin the loop.
        For Each ws In wbCopy.Worksheets
            'run process
            Call formattradefiledata
            'end process

            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBox ws.Name
        Next ws
        MsgBox wbCopy.Name
        wbCopy.Close SaveChanges:=False
        MyFile = Dir
    Loop

    'turns settings back on that you turned off before looping folders
    MemorySave False

End Sub
Sub MemorySave(isOn As Boolean)

    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    Application.DisplayStatusBar = Not (isOn)
    ActiveSheet.DisplayPageBreaks = False

End Sub

选项显式
子testLoopTabs（）
将MyFolder设置为字符串，将MyFile设置为字符串
将wb设置为工作簿，将wbCopy设置为工作簿
将ws设置为“工作表”以循环浏览所有工作表
'打开一个文件对话框，供用户选择文件夹
使用Application.FileDialog（msoFileDialogFolderPicker）
.AllowMultiSelect=False
显示
MyFolder=.SelectedItems（1）
呃，明白了
以
'停止屏幕更新、计算、事件和状态栏更新，以帮助代码更快地运行
'您将打开和关闭许多文件，因此这将阻止您的屏幕显示这些文件
MemorySave True“您可以改用此过程
'此部分将循环浏览并打开选定文件夹中的每个文件
'然后在打开下一个文件之前关闭该文件
MyFile=Dir（MyFolder&“\”，vbReadOnly）
设置wb=ThisWorkbook'以引用包含代码的工作簿
当我的文件“”时执行此操作
设置wbCopy=Workbooks.Open（文件名：=MyFolder&“\”&MyFile，UpdateLinks:=False，只读：=True）
'循环工作表
'开始循环。
对于wbCopy.worksheet中的每个ws
'运行进程
调用formattradefiledata
“结束过程
'下一行显示如何在中引用图纸
'通过在对话框中显示工作表名称来执行循环。
MsgBox ws.Name
下一个ws
MsgBox wbCopy.Name
wbCopy.Close SaveChanges:=False
MyFile=Dir
环
'将在循环文件夹之前关闭的设置重新打开
记忆性假动作
端接头
子MemorySave（作为布尔值）
Application.Calculation=IIf（isOn，xlCalculationManual，xlCalculationAutomatic）
Application.EnableEvents=Not（isOn）
Application.screenUpdate=Not（isOn）
Application.DisplayStatusBar=Not（isOn）
ActiveSheet.DisplayPageBreaks=False
端接头

请注意，我为内存管理添加了另一个过程（只需使用True调用该过程即可激活内存保存选项，使用false调用该过程即可重新启用所有功能）

当你参考工作手册和工作表时，没有什么会出错。在“我的代码”中，带有代码的工作簿被引用为

wb

，打开的文件被引用为

wbCopy

，并循环浏览所有工作表，您可以在wbCopy中为每个ws使用

。引用ws-as-Worksheet
后，工作表

。就像告诉excel，对于工作簿

wbCopy

中工作表中的每个工作表，使用工作簿变量，而不是依赖

ActiveWorkbook

<代码>将wb设置为工作簿，然后

设置wb=工作簿。打开（文件名：=MyFolder&“\”&MyFile，UpdateLinks:=False）

。这将为您提供一个工作簿参考，然后使用。我已经修改了代码，将Dim wb包含为工作簿，并将wb设置为注释中的。然后我用wb替换了所有ActiveWorkbook。然而，它仍然不起作用。在包含多个工作表的文件上，它只会循环回第一个工作表。@Temujin81您能在帖子中更新代码吗？因此，我们可以进一步帮助您。同意，您可以共享

formattradefiledata

代码吗？我已经更新了上面的代码，以显示我的格式化过程代码（它是介于“运行过程”和“结束过程”注释之间的代码）。是这里的某些东西使它无法工作。当我使用上面的Damian代码和一个简单的格式化过程时，它工作得很好。

Option Explicit
Sub testLoopTabs()

    Dim MyFolder As String, MyFile As String
    Dim wb As Workbook, wbCopy As Workbook
    Dim ws As Worksheet 'to loop through all the sheets

    'Opens a file dialog box for user to select a folder

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

    'stops screen updating, calculations, events, and statsu bar updates to help code run faster
    'you'll be opening and closing many files so this will prevent your screen from displaying that
    MemorySave True 'You can use this procedure instead

    'This section will loop through and open each file in the folder you selected
    'and then close that file before opening the next file

    MyFile = Dir(MyFolder & "\", vbReadOnly)
    Set wb = ThisWorkbook 'to refer to the workbook containing the code

    Do While MyFile <> ""
        Set wbCopy = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False, ReadOnly:=True)
        'loop worksheet
         ' Begin the loop.
        For Each ws In wbCopy.Worksheets
            'run process
            Call formattradefiledata
            'end process

            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBox ws.Name
        Next ws
        MsgBox wbCopy.Name
        wbCopy.Close SaveChanges:=False
        MyFile = Dir
    Loop

    'turns settings back on that you turned off before looping folders
    MemorySave False

End Sub
Sub MemorySave(isOn As Boolean)

    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    Application.DisplayStatusBar = Not (isOn)
    ActiveSheet.DisplayPageBreaks = False

End Sub