提示文件打开，进行更改并保存为另一个副本，然后关闭 Unseve原始文件

Question

我正在尝试提示用户打开文件1和文件2。然后在文件2上进行更改(突出显示非日期单元格(然后保存更改的文件2的副本。同时，将原始file2 untave保持并关闭。

下面是我的代码运行结果：

file1打开，

file2突出显示，但没有保存副本，并且它保持打开状态

请建议它有什么问题。

 Sub LogSAVEAS()
 'prompt open file 1
 N = Application.GetOpenFilename _
 (Title:="Please choose file1", _
 FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
Set twb = Workbooks.Open(N)
If N = False Then
MsgBox "No file selected. Please click run again and select file", 
vbExclamation, "Sorry!"
Exit Sub
Else
End If
'prompt open file 2
R = Application.GetOpenFilename _
(Title:="Please choose file2", _
FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
Set extwbk = Workbooks.Open(R)
If R = False Then
MsgBox "No file selected. Please click run again and select file.", 
vbExclamation, "Sorry!"
Exit Sub
Else
End If

Dim WS As Worksheet
For Each WS In extwbk.workseets 'highlight issue format cell in file2
Call highlightdate(WS)
Next

Set extwbk = ActiveWorkbook
ActiveWorkbook.Sheets.copy 'copy file2 with highlight and save as "log"
dt = Format(CStr(Now), "yyyymmddhhmm")
ActiveWorkbook.SAVEAS Filename:=extwbk.Path & "log" & dt & ".xlsx"
ActiveWorkbook.Close savechanges:=True 'save and close log
extwbk.Close savechanges:=False 'unsave and close file2
twb.Close savechanges:=True 'save and close file1

End Sub
Sub highlightnondate(WS As Worksheet)
With WS
  Set t = .Rows(1).Find("Date", lookat:=xlPart)
   If t Is Nothing Then Exit Sub
  For Each currentCell In Intersect(.Columns(t.Column), .UsedRange.Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1, 0))
        If Not IsEmpty(currentCell) And Not IsDate(currentCell.Value) Then counter = counter + 1
     If Not IsEmpty(currentCell) And Not IsDate(currentCell.Value) Then currentCell.Interior.color = 56231
   Next currentCell
   End With

End Sub

Answer 1

我不确定，但是问题是您首先关闭ActiveWorkbook？