Vba Excel关闭两个工作簿，而不是一个

我让工作簿1运行宏/VBA

工作簿2的文件位置保存在打开的工作簿1的工作表中

信息从工作簿2复制到工作簿1 关闭工作簿2

使用多个工作簿重复此操作

完成

但是，excel会以随机间隔关闭所有文件，而不保存。我的直觉是，它正在阅读的工作簿中存在某种混乱，因此它关闭了所有的工作簿

是否有某种方法我做错了，我应该在什么地方改变什么

我的代码如下：

Option Explicit
Sub Test_macro()

Application.ScreenUpdating = False

'General Variables
Dim Title           As String    'Title it is looking for
Dim Finder          As Range     'Help with titles
Dim Chosen          As String    'The chosen area to be viewed
Dim Offsetter       As Integer   'Help with offset chosen value

'Coying of stuff from other workbook into this one
Dim workB1          As Workbook  'This workbook
Dim workB2          As Workbook  'Where I will copy from
Dim sourceColumn    As Range     'Range from the budget pack
Dim targetColumn    As Range     'Range to be pasted in here
Dim copyColumn      As Variant   'Columns to be copied
Dim columnCount     As Integer   'Value of loop
copyColumn = Array("D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")

'For looping through all the workbooks
Dim x               As Integer
Dim workbookCount   As Integer
Dim Placer          As Integer

'Set file name for this workbook
Set workB1 = ThisWorkbook

'Clear information
Sheets("Selection").Columns("D:S").Clear

Sheets("Lookup").Select
Range("H4").Select
workbookCount = Range(ActiveCell, ActiveCell.End(xlDown)).Count

For x = 0 To workbookCount - 1

    'Clear information
    Sheets("DataPaste").Columns("D:R").Clear

    'Check the file exists
    If Not Dir(Sheets("Lookup").Range("H4").Offset(x, 0).Value & Sheets("Lookup").Range("I4").Offset(x, 0).Value) = vbNullString Then

        'these rows show what sheet it is referring to
        Application.ScreenUpdating = True
        Sheets("Selection").Select
        Sheets("Selection").Range("E3") = Sheets("Lookup").Range("H4").Offset(x, 0).Value & Sheets("Lookup").Range("I4").Offset(x, 0).Value
        Application.ScreenUpdating = False

        'Open and set Name of other workbook
        Workbooks.Open Filename:=Sheets("Lookup").Range("H4").Offset(x, 0).Value & Sheets("Lookup").Range("I4").Offset(x, 0).Value
        Set workB2 = Workbooks(workB1.Sheets("Lookup").Range("I4").Offset(x, 0).Value)
        'workB2.Activate
        workB1.Activate

        'Copy into this file, columns are labelled in the array-make sure columnCount matches array count
        Do Until columnCount >= 15
            Set sourceColumn = Workbooks(Sheets("Lookup").Range("I4").Offset(x, 0).Value).Worksheets(Sheets("Selection").Range("B2").Value).Columns(copyColumn(columnCount))
            Set targetColumn = Workbooks("Macro to get budget lines V3").Worksheets("DataPaste").Columns(copyColumn(columnCount))
            sourceColumn.Copy Destination:=targetColumn
            columnCount = columnCount + 1
        Loop

        'Close the second workbook
        workB2.Close SaveChanges:=False

        'Copy and paste it onto the correct tab
        Chosen = Sheets("Selection").Range("B3")
        Sheets("DataPaste").Select
        Columns("D:D").Select
        Cells.Find(Chosen).Select

        'If cell is what we want, copy and paste, go down one cell and loop
        Do Until ActiveCell.Value = ""
            If ActiveCell.Value <> "" Then
                Sheets("DataPaste").Rows(ActiveCell.Row).EntireRow.Copy
                Sheets("Selection").Select
                Sheets("Selection").Range("A5").Offset(Placer, 0).Select
                Sheets("Selection").Paste

                Sheets("Selection").Range("B5").Offset(Placer, 17) = Sheets("Lookup").Range("I4").Offset(x, 0).Value

                Sheets("DataPaste").Select
                Columns("D:D").Select
                Cells.Find(Chosen).Offset(Offsetter, 0).Select
            End If
            ActiveCell.Offset(1, 0).Select
            Offsetter = Offsetter + 1
            Placer = Placer + 1
        Loop

    'If the workbook does not exist in the folder then alert people to it
    Else
    MsgBox (Sheets("Lookup").Range("I4").Offset(x, 0).Value) & " Does not exist"

    End If

    'Reset Variables
    columnCount = 0
    Offsetter = 0

'Go onto the next workbook
Next x

'End operation
Sheets("Selection").Select
Range("A1").Select
Sheets("Selection").Columns("T:V").Clear
MsgBox "All Done"

Application.ScreenUpdating = True

End Sub

选项显式
子测试_宏（）
Application.ScreenUpdating=False
“一般变量
Dim Title作为它正在查找的字符串的标题
Dim Finder作为测距仪提供标题帮助
Dim选择为字符串“要查看的选定区域”
设置偏移量为整数的Dim Offsetter“使用偏移量选择值的帮助”
“将其他工作簿中的内容压缩到本工作簿中
将工作B1设置为工作簿“此工作簿”
将workB2设置为工作簿“我将从中复制”
Dim sourceColumn作为预算包中的“范围”
将targetColumn变暗为要粘贴到此处的“范围”
Dim copyColumn作为要复制的变量列
Dim columnCount作为循环的整数值
copyColumn=数组（“D”、“E”、“F”、“G”、“H”、“I”、“J”、“K”、“L”、“M”、“N”、“O”、“P”、“Q”、“R”）
“在所有的工作手册中循环
作为整数的Dim x
将工作簿计数设置为整数
作为整数的Dim Placer
'设置此工作簿的文件名
Set workB1=此工作簿
"明确信息",
表（“选择”）。列（“D:S”）。清除
工作表（“查找”）。选择
范围（“H4”）。选择
workbookCount=范围（ActiveCell，ActiveCell.End（xlDown））.Count
对于x=0，工作簿计数为-1
"明确信息",
表格（“数据粘贴”）。列（“D:R”）。清除
'检查文件是否存在
如果不是Dir（Sheets（“Lookup”）.Range（“H4”）.Offset（x，0）。Value和Sheets（“Lookup”）.Range（“I4”）.Offset（x，0）。Value）=vbNullString，则
'这些行显示它所指的工作表
Application.ScreenUpdating=True
工作表（“选择”）。选择
图纸（“选择”）.范围（“E3”）=图纸（“查找”）.范围（“H4”）.偏移量（x，0）。值和图纸（“查找”）.范围（“I4”）.偏移量（x，0）。值
Application.ScreenUpdating=False
'打开并设置其他工作簿的名称
工作簿.打开文件名：=工作表（“查找”）.范围（“H4”）.偏移量（x，0）.值和工作表（“查找”）.范围（“I4”）.偏移量（x，0）.值
设置workB2=工作簿（workB1.工作表（“查找”）.范围（“I4”）.偏移量（x，0）.值）
'workB2.Activate
工作1.激活
'复制到此文件中，列在数组中被标记确保columnCount与数组计数匹配
直到columnCount>=15为止
设置sourceColumn=工作簿（工作表（“查找”）.Range（“I4”）.Offset（x，0）.Value）.工作表（工作表（“选择”）.Range（“B2”）.Value）.列（copyColumn（columnCount））
设置targetColumn=工作簿（“获取预算行V3的宏”）。工作表（“数据粘贴”）。列（copyColumn（columnCount））
sourceColumn.Copy目标：=targetColumn
columnCount=columnCount+1
环
'关闭第二个工作簿
workB2.Close SaveChanges:=False
'复制并粘贴到正确的选项卡上
选择=板材（“选择”）。范围（“B3”）
工作表（“数据粘贴”）。选择
列（“D:D”）。选择
单元格。查找（选定）。选择
“如果单元格是我们想要的，复制并粘贴，沿着一个单元格循环
直到ActiveCell.Value=“”
如果ActiveCell.Value为“”，则
工作表（“数据粘贴”）.Rows（ActiveCell.Row）.EntireRow.Copy
工作表（“选择”）。选择
板材（“选择”）。范围（“A5”）。偏移量（砂矿，0）。选择
纸张（“选择”）。粘贴
图纸（“选择”）.范围（“B5”）.偏移量（放置器，17）=图纸（“查找”）.范围（“I4”）.偏移量（x，0）.值
工作表（“数据粘贴”）。选择
列（“D:D”）。选择
单元格。查找（选定）。偏移（偏移器，0）。选择
如果结束
ActiveCell.Offset（1，0）。选择
偏移器=偏移器+1
砂矿=砂矿+1
环
'如果文件夹中不存在工作簿，请提醒人们注意它
其他的
MsgBox（图纸（“查找”）。范围（“I4”）。偏移量（x，0）。值）和“不存在”
如果结束
'重置变量
columnCount=0
偏移量=0
'转到下一个工作簿
下一个x
"结束操作",
工作表（“选择”）。选择
范围（“A1”）。选择
表（“选择”）。列（“T:V”）。清除
MsgBox“全部完成”
Application.ScreenUpdating=True
端接头

工作B2。关闭

是关闭工作簿的操作

这是设置

工作B2

的方式：

Set workB2 = Workbooks(workB1.Sheets("Lookup").Range("I4").Offset(x, 0).Value)

在循环中执行此操作-

，x=0到workbookCount-1

。因此，代码很可能将工作簿设置为

workB2

，然后将其关闭，然后将

workB2

设置为另一个工作簿，然后再次将其关闭。检查此范围以确保：

workB1.Sheets("Lookup").Range("I4").Offset(x, 0).Value

编辑：

要更好地了解正在发生的事情，请更改此行：

workB2.使用此代码关闭

：

MsgBox workB2.Name
Stop
workB2.Close

---

当程序停止时，查看范围。

正确，代码循环加载工作簿，将其中一个设置为WorkB2，关闭它，然后将新的一个重新分配给WorkB2。在这个范围内有什么我应该找的吗？除了最后一个单元格外，没有空格，这就是为什么我有workbookCount-1。此外，它有时会在导入5/6工作簿后退出，而在其他时间，它根本不会退出。是这样吗sporadic@TejkaranSamra-查看编辑和下面的文本。然后谷歌“如何调试VBA”并享受调试的乐趣：）