此程序提示用户选择文件夹。在一个文件夹中是要复制的数据，在另一个目标文件中。这些文件共享4位数字“ el数字”的命名结构。
除了选择数据，复制数据并将其粘贴到目标文件夹外，此代码中的所有内容均有效。
当前，它通知我我已经成功匹配了文件，并且两个文件都已打开。我确认匹配正确并且打开了正确的文件。关闭和保存功能当前已被注释掉。
我似乎根本无法获得选择工作表的代码。我一直在尝试使用下面的代码来做一个简单的clearcontents，但这也不起作用。
Set myDatabook = ActiveWorkbook
ActiveWorkbook.Worksheets(1).Range("A1").ClearContents
与该问题最相关的代码是在%%%%%%%%%%的行之间，但是所有这些代码都包括在内以进行故障排除。
Sub OPDwgUpdateFromMatchingSheetsELNumber()
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
' /////////////////// all OP Dwg opening and checks only\\\\\\\\\\\\\\\\\\\\\\\\
Dim MyOPDwgPath As String
Dim OPDwgCheckSheet As Worksheet
Dim FilesInPathOPDwg As String
Dim MyOPDwgFiles() As String, FnumOPDwg As Long 'dim () string means array , the comma means the FnumOPDwg is used with it
Dim myOPdwgbook As Workbook
Dim elNumOpDwg As String`enter code here`
Dim elNumOPDwgArray() As String, FnumEL As Long
MyOPDwgPath = GetOPDwgFolders() ' call getOPDwgFolder functoin
MsgBox (MyOPDwgPath) 'returns in msg box
'Add a slash at the end if the user forget it
If Right(MyOPDwgPath, 1) <> "\" Then
MyOPDwgPath = MyOPDwgPath & "\"
End If
FilesInPathOPDwg = Dir(MyOPDwgPath & "*.xl*")
If FilesInPathOPDwg = "" Then 'If there are no Excel files in the folder exit the sub
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
FnumOPDwg = 0
Do While FilesInPathOPDwg <> ""
FnumOPDwg = FnumOPDwg + 1
ReDim Preserve MyOPDwgFiles(1 To FnumOPDwg)
MyOPDwgFiles(FnumOPDwg) = FilesInPathOPDwg
FilesInPathOPDwg = Dir()
elNumOpDwg = Right(Left(MyOPDwgFiles(FnumOPDwg), 7), 4) 'parse out just el num **MAY HAVE TO BE CHANGED IF NAMING CONVENTION CHANGES**
ReDim Preserve elNumOPDwgArray(1 To FnumOPDwg)
elNumOPDwgArray(FnumOPDwg) = elNumOpDwg
'Debug.Print (elNumOpDwg & " " & FnumOPDwg) 'print in debugging window press control + G to open
Loop
'Debug.Print (elNumOPDwgArray(3))
' //////////// data sheet check \\\\\\\\\\\\\\\\\\\\\
'Data
Dim myDataPath As String
Dim myDatabook As Workbook
Dim myDataCheckSheet As Worksheet
Dim MyDataFiles() As String, FnumData As Long ' array of data file
Dim FilesInPathData As String 'location of data files
Dim elNumDataSheet As String 'elNum parse from data file name
Dim elNumDataArray() As String, FnumDataEL As Long
myDataPath = GetDataFolders()
MsgBox (myDataPath)
'Add a slash at the end if the user forget it
If Right(myDataPath, 1) <> "\" Then
myDataPath = myDataPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPathData = Dir(myDataPath & "*.xl*")
If FilesInPathData = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
FnumData = 0
Do While FilesInPathData <> ""
FnumData = FnumData + 1
ReDim Preserve MyDataFiles(1 To FnumData)
MyDataFiles(FnumData) = FilesInPathData
FilesInPathData = Dir()
elNumDataSheet = Right(Left(MyDataFiles(FnumData), 7), 4)
ReDim Preserve elNumDataArray(1 To FnumData)
elNumDataArray(FnumData) = elNumDataSheet
Loop
'/////////////////////end data retrieval\\\\\\\\\\\\\\\\
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Loop through all files in the array(myFiles)
If FnumOPDwg > 0 Then
For FnumOPDwg = LBound(MyOPDwgFiles) To UBound(MyOPDwgFiles)
Set myOPdwgbook = Nothing
On Error Resume Next
Set myOPdwgbook = Workbooks.Open(MyOPDwgPath & MyOPDwgFiles(FnumOPDwg))
'Debug.Print (MyOPDwgPath)
'Debug.Print (MyOPDwgFiles(FnumOPDwg) & "1")
On Error GoTo 0
For FnumData = LBound(MyDataFiles) To UBound(MyDataFiles)
If FnumData > 0 Then
If elNumDataArray(FnumData) = elNumOPDwgArray(FnumOPDwg) Then
Set myDatabook = Nothing
On Error Resume Next
Set myDatabook = Workbooks.Open(myDataPath & MyDataFiles(FnumData))
On Error GoTo 0
'Debug.Print (FilesInPathData)
'Debug.Print (MyDataFiles(FnumData) & "2")
MsgBox (elNumDataArray(FnumData))
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If Not myOPdwgbook Is Nothing Then
'Change cell value(s) in one worksheet in mybook
On Error Resume Next
With myOPdwgbook.Worksheets(1)
With myDatabook.Worksheets(1)
If .ProtectContents = False Then
' actual copy pasting done here
myDatabook.Range("A1:DE31").Value = myOPdwgbook.Cells("A59:DE90").Value
Else
ErrorYes = True
End If
End With
End With
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
If Err.Number > 0 Then
ErrorYes = True
Err.Clear
' myDatabook.Close savechanges:=False
Else
' myDatabook.Close savechanges:=False
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If
End If
If Err.Number > 0 Then
ErrorYes = True
Err.Clear
'myOPdwgbook.Close savechanges:=False 'Close mybook without saving
Else
'myOPdwgbook.Close savechanges:=True
End If
On Error GoTo 0
End If
Next FnumData
Next FnumOPDwg 'iterate
End If
If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
答案 0 :(得分：0)
应谨慎使用On Error Resume Next，并且始终由On Error Goto 0（您这样做）终止。但是，这些行：
On Error Resume Next
Set myDatabook = Workbooks.Open(myDataPath & MyDataFiles(FnumData))
On Error GoTo 0
之后应检查是否正确分配了myDatabook。如果不是该行：
myDatabook.Range("A1:DE31").Value = myOPdwgbook.Cells("A59:DE90").Value
肯定会导致错误。
在不分析代码的情况下，我强烈建议您按照Comintern的建议注释掉那些行。