Question

我有工作簿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

Answer 1

workB2.Close关闭了您的工作簿。

这是您设置workB2：

的方法

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

您可以循环执行此操作 - For x = 0 To workbookCount - 1。因此，很可能代码将工作簿设置为workB2，然后关闭它，然后将workB2设置为另一个工作簿并再次关闭它。检查此范围以确定：

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

修改

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

workB2.Close使用此代码：

MsgBox workB2.Name Stop workB2.Close

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

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

1 个答案: