我一直在开发另一个程序，该程序将从工作表中获取特定数据，然后将其粘贴到工作簿上的特定工作表中，具体取决于第一个工作表中数据中找到的零件类型。
为了能够解密将要调用的工作表，我必须编写If语句，以基于“部件类型”单元格值确定将调用并粘贴到哪个工作表。由于大约涉及4个子项（复制和粘贴日期，时间，零件类型和特定的按压力），因此我在每个子项中都有IF条语句，它只会单独调用这些子项。
为简化此操作，只需在每个子程序的开头调用“正确的工作表”，而不必使用其他IF语句，我一直在尝试将工作表设置为变量，因为您会见下文：
With ActiveWorkbook
If CaseBRH = True Then
CorrectFile = Sheets("Case B Left Hand")
ElseIf CaseBLH = True Then
CorrectFile = Sheets("Case B Right Hand")
ElseIf Feedshaft = True Then
CorrectFile = Sheets("Feedshaft")
End If
CorrectFile是我在第一个Sub例程之前定义为Public的变量。
基本上，我所做的是使用StrComp并查找CaseBLH，CaseBRH或Feedshaft是否为真，并且该零件在我进行这些更改之前一直在起作用。
现在的问题是，当我到达这样的一行时：
Workbooks("Consolidated Diagramm Data.xlsx").Activate
CorrectFile.Activate
Range("C1").PasteSpecial Transpose:=True
Application.CutCopyMode = False
在完成CorrectFile.Activate行之后，它会完全跳出子菜单并转到下一个子菜单，并且不会调用正确的工作表。有什么建议吗？
下面是整个模块：
Public Path As String
Public Counter As Integer
Public LHCounter As Integer
Public RHCounter As Integer
Public FeedshaftCounter As Integer
Public NameFile As Workbook
Public Feedsft As String
Public RightHand As String
Public LeftHand As String
Public Feedshaft As Boolean
Public CaseBRH As Boolean
Public CaseBLH As Boolean
Public Celltxt As String
Public MyFolder As String 'Path collected from the folder picker dialog
Public MyFile As String 'Filename obtained by DIR function
Public wbk As Workbook 'Used to loop through each workbook
Public thisWb As Workbook
Public CorrectFile As Worksheet
Sub Consolidate_Diagramms_Data()
Set NameFile = Workbooks.Add
Dim wb As Workbook
Application.DisplayAlerts = False
NameFile.SaveAs FileName:="C:\DataAnalyzation\Consolidated Diagramm Data.xlsx"
Set wb = ActiveWorkbook
Sheets("Sheet1").Name = "Case B Left Hand"
Worksheets.Add().Name = "Case B Right Hand"
Worksheets.Add().Name = "Feedshaft"
Call AllWorkbooks
End Sub
Sub AllWorkbooks()
Set thisWb = ActiveWorkbook
On Error Resume Next
Application.ScreenUpdating = False 'Opens the folder picker dialog to allow user selection
MsgBox "Please select the folder from which you wish to consolidate your data."
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a folder"
Exit Sub
End If
MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
Counter = 0
LHCounter = 0
RHCounter = 0
FeedshaftCounter = 0
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
Counter = Counter + 1
Set wbk = Workbooks.Open(FileName:=MyFolder & MyFile)
Application.ScreenUpdating = False
EventState = Application.EnableEvents
Application.EnableEvents = False
CalcState = Application.Calculation
Application.Calculation = xlCalculationManual
PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False
Feedsft = "Feed Shaft"
RightHand = "Case B Right Hand"
LeftHand = "Case B Left Hand"
Celltxt = Range("D2").Value
If StrComp(Celltxt, Feedsft, vbTextCompare) = 0 Then
CaseBLH = False
CaseBRH = False
Feedshaft = True
FeedshaftCounter = FeedshaftCounter + 1
ElseIf StrComp(Celltxt, LeftHand, vbTextCompare) = 0 Then
Feeshaft = False
CaseBRH = False
CaseBLH = True
LHCounter = LHCounter + 1
ElseIf StrComp(Celltxt, RightHand, vbTextCompare) = 0 Then
Feedshaft = False
CaseBLH = False
CaseBRH = True
RHCounter = RHCounter + 1
End If
With ActiveWorkbook
If CaseBRH = True Then
Set CorrectFile = Sheets("Case B Left Hand")
ElseIf CaseBLH = True Then
Set CorrectFile = Sheets("Case B Right Hand")
ElseIf Feedshaft = True Then
Set CorrectFile = Sheets("Feedshaft")
End If
End With
If Feedshaft = True And FeedshaftCounter = 1 Then 'If it is a Feedshaft and this is the first part of that part type
Call Copy_Position
Call Paste_Position
Call Copy_Paste_Date
Call Copy_PartType
Call Paste_PartType
ElseIf CaseBLH = True And LHCounter = 1 Then 'If it is a Case B LH and this is the first part of that part type
Call Copy_Position
Call Paste_Position
Call Copy_Paste_Date
Call Copy_PartType
Call Paste_PartType
ElseIf CaseBRH = True And RHCounter = 1 Then 'If it is a Case B RH and this is the first part of that part type
Call Copy_Position
Call Paste_Position
Call Copy_Paste_Date
Call Copy_PartType
Call Paste_PartType
End If
Call Copy_Paste_Force
wbk.Close savechanges:=False
MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("A total of " & Counter & " files have been consolidated. This includes " & LHCounter & " Left Hand Part(s), " & RHCounter & " Right Hand Part(s) and " & FeedshaftCounter & " Feedshaft(s).")
End Sub
Sub Copy_Position()
Range("C4").Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy 'Copies the Part Type displayed in Cell C4
End Sub
Sub Paste_Position()
If Range("C4") = "" Then
MsgBox ("There is no data in this file") 'Checks for an empty value in Cell C4
End If
Workbooks("Consolidated Diagramm Data.xlsx").Activate 'Activates Workbook
CorrectFile.Range("C1").PasteSpecial Transpose:=True 'Pastes Position data into a Row, starting at Column C
Application.CutCopyMode = False
End Sub
Sub Copy_Paste_Date()
Workbooks(MyFile).Activate 'Activates the Data Sheet
ActiveSheet.Range("B2").Copy 'Copies the Date
Workbooks("Consolidated Diagramm Data.xlsx").Activate 'Activates the final Workbook
CorrectFile.Range("A2").PasteSpecial Paste:=xlPasteAll 'Pastes the Date into "A2"
Application.CutCopyMode = False
End Sub
Sub Copy_PartType()
Workbooks(MyFile).Activate 'Activates Data Sheet
ActiveSheet.Range("D2").Copy 'Copies part type
End Sub
Sub Paste_PartType()
If Range("D2") = "" Then
MsgBox ("There is no data in this file") 'Checks for no values in "D2"
End If
Workbooks("Consolidated Diagramm Data.xlsx").Activate 'Activates the Correct
CorrectFile.Range("B2").PasteSpecial Paste:=xlPasteAll 'Pastes the part type into "B2"
Application.CutCopyMode = False
End Sub
Sub Copy_Paste_Force()
Dim CR As Long
Dim Cpy As Range
Workbooks(MyFile).Activate 'Calls up the Data Sheet
Range("D4").Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy 'Copies Force Values
If Range("D4") = "" Then
MsgBox ("There is no data in this file") 'Checks for no values in "D4"
End If
Workbooks("Consolidated Diagramm Data.xlsx").Activate
If Feedshaft = True And FeedshaftCounter = 1 Then 'If it is Feedshaft and no parts have been pasted
GoTo PasteInitial
ElseIf Feedshaft = True And FeedshaftCounter > 1 Then 'If it is Feedshaft and one part has already been pasted
GoTo PasteAfter
ElseIf CaseBLH = True And LHCounter = 1 Then 'If it is Case B LH and no parts have been pasted
GoTo PasteInitial
ElseIf CaseBLH = True And LHCounter > 1 Then 'If it is Case B LH and one part has already been pasted
GoTo PasteAfter
ElseIf CaseBRH = True And RHCounter = 1 Then 'If it is Case B RH and no parts have been pasted
GoTo PasteInitial
ElseIf CaseBRH = True And RHCounter > 1 Then 'If it is Case B RH and one part has already been pasted
GoTo PasteAfter
End If
PasteInitial: 'Pastes the first force values into Column C underneath the vertical position
Range("C2").Activate
ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
GoTo Nd
PasteAfter: 'After the first force value is Pasted, this searches for the last row, offsets, and pastes into the next empty row
CR = Cells(Rows.Count, "C").End(xlUp).Row
Range(CR).Activate
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial Transpose:=True
Application.CutCopyMode = False
GoTo Nd
Nd:
End Sub