Question

Excel VBA 逐个激活现在打开的工作簿

Sub 自动填充()

Application.ScreenUpdating = False '关闭屏幕更新

Application.DisplayAlerts = False '关闭提示窗口

Dim i As Integer, fn As Variant, sht As Variant

fn = Array(表1.xls,表2.xls, 表3.xls, 表4.xls, 表5.xls, 表6.xls, 表7.xls)

sht = Array(表1, 表2, 表3, 表4, 表5, 表6, 表7)

For i = 0 To 6

Windows("fn(i)").Activate
Cells.Select
Selection.Copy
Windows("汇总.xls").Activate
Sheets("sht(i)").Select
Cells.Select
With Selection
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
Windows("fn(i)").Activate
ActiveWindow.Close 'savechangs:=False '关闭窗口不保存
fn(i) = fn(i + 1)
sht(i) = sht(i + 1)
Next i

i = 0

For i = 0 To 6
Windows("汇总格式.xls").Activate
Sheets("格式").Select
Cells.Select
Selection.Copy
Windows("汇总.xls").Activate
Sheets("sht(i)").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sht(i) = sht(i + 1)
Next i
Application.DisplayAlerts = True '打开提示窗口

ActiveWorkbook.SaveAs Filename:="D:\临时文件\汇总.xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False '文件保存路径及文件名
Application.ScreenUpdating = True '打开屏幕更新
ActiveWindow.Close
Windows("汇总格式.xls").Activate

End Sub

我是初学者，根据自己录的宏写的，有好多错误，希望高手帮忙看看

Answer 1

Sub 自动填充()

    Application.ScreenUpdating = False '关闭屏幕更新

    Application.DisplayAlerts = False '关闭提示窗口

    Dim i As Integer, fn As Variant, sht As Variant

    fn = Array("表1.xls", "表2.xls", "表3.xls", "表4.xls", "表5.xls", "表6.xls", "表7.xls")

    sht = Array("表1", "表2", "表3", "表4", "表5", "表6", "表7")

    For i = 0 To 6

        Windows(fn(i)).Activate

        Cells.Select

        Selection.Copy

        Windows("汇总.xls").Activate

        Sheets(sht(i)).Select

        Cells.Select

        With Selection

            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            .PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        End With

        Windows(fn(i)).Activate

        ActiveWindow.Close False 'savechangs:=False '关闭窗口不保存

       ' fn(i) = fn(i + 1)

       ' sht(i) = sht(i + 1)

    Next i

    i = 0

    For i = 0 To 6

        Windows("汇总格式.xls").Activate

        Sheets("格式").Select

        Cells.Select

        Selection.Copy

        Windows("汇总.xls").Activate

        Sheets(sht(i)).Select

        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

            SkipBlanks:=False, Transpose:=False

    sht(i) = sht(i + 1)

    Next i

    Application.DisplayAlerts = True '打开提示窗口


    ActiveWorkbook.SaveAs Filename:="D:\临时文件\汇总.xls", FileFormat _

        :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _

        False, CreateBackup:=False '文件保存路径及文件名

    Application.ScreenUpdating = True '打开屏幕更新

    ActiveWindow.Close

    Windows("汇总格式.xls").Activate

End Sub
‍