我的代码是引用一个命名范围(泵号),在表(另一个工作表)中查找最后一个实例,复制在其中找到的行,并将该数据粘贴到在表中创建的新行中。然后循环遍历另一张纸上的一系列单元并找到真实值。如果值为true,则将复制另一个命名的range(Hours),并将该值粘贴到正确列的表中。该代码在调试中正确执行,一次只执行一行,但是在正常运行时,它不会复制表中的最后一行数据并将值粘贴到新行中。无法正常运行的代码从第90行开始
Sub SavePumpMaintenance()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim tbla As ListObject, last_row, total_stage As Integer
Dim issue, pump, pump_hrs, main_date, main_code As String
Dim correct_plunger, correct_part As Boolean, Data As Worksheet
Dim Maint As Worksheet, wSheet As Worksheet, r As Long
Dim tbl As ListObject, newrow As ListRow, i As Long
Dim cells As Range, LR As Integer, Hist As Worksheet
Set Hist = Sheet26
Set CurrentHours = Range("CurrentHours")
Set tbl = Hist.ListObjects("Historical")
Set newrow = tbl.ListRows.Add
Set Data = Sheet5
Set Maint = Sheet3
Set tbla = Maint.ListObjects("MaintPerformed")
correct_plunger = Data.Range("N6").Value
correct_part = Data.Range("N10").Value
main_code = Data.Range("Y8").Value
issue = Data.Range("Y11").Value
last_row = Data.Range("N11").Value
pump = Maint.Range("C6").Value
pump_hrs = Maint.Range("C7").Value
main_date = Maint.Range("C8").Value
total_stage = Maint.Range("C9").Value
LR = tbl.Range(Rows.Count).End(xlUp).Row
'Unprotect all sheets
For Each wSheet In Worksheets
wSheet.Unprotect Password:="SomePassword"
Next wSheet
If pump = "" Then
MsgBox "Please select a pump."
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
If pump_hrs = "" Then
MsgBox "Please enter hours."
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
If Range("Date") = "" Then
MsgBox "Please enter date and time of maintenance."
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
If correct_plunger = False Then
MsgBox "Incorrect plunger type selected"
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
If correct_part = False Then
MsgBox "Incorrect part type selected"
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
Data.Range("T3:T37").Copy 'Copy used parts/pump info to maintenance table
Maint.Range("O1").Offset(last_row,0).PasteSpecial xlValues,Transpose:=True
Data.Range("U3:U12").Copy
Maint.Range("BJ1").Offset(last_row,0).PasteSpecial xlValues,Transpose:=True
Maint.Range("J1").Offset(last_row, 0).Value = pump
Maint.Range("J1").Offset(last_row, 1).Value = pump_hrs
Maint.Range("J1").Offset(last_row, 2).Value = total_stage
Maint.Range("J1").Offset(last_row, 3).Value = main_date
Maint.Range("J1").Offset(last_row, 4).Value = main_code
Maint.Range("J1").Offset(last_row, 63).Value = issue
'Copy last set of historical data for pump 'add maintenance to history
For r = 1 To LR Step 1
If tbl.Range(r, 1).Value = Range("Pumpnumber") Then
Range("H" & r & ":V" & r).Copy
newrow.Range(8).PasteSpecial Paste:=xlValues
End If
Next r
With newrow 'Paste current pump information
.Range(1) = Range("Pumpnumber")
.Range(2) = Range("Date")
.Range(3) = CurrentHours
.Range(4) = Range("Position")
.Range(5) = Range("Fleet")
.Range(6) = Range("WFNumb")
.Range(7) = Range("OStage")
End With
'copy hours from maintenance if checked into maint. history
For i = 1 To 5
If Maint.cells(13, i + 2).Value = True Then
CurrentHours.Copy
newrow.Range(7 + i).PasteSpecial xlPasteValues
End If
If Maint.cells(16, i + 2).Value = True Then
CurrentHours.Copy
newrow.Range(12 + i).PasteSpecial xlPasteValues
End If
If Maint.cells(21, i + 2).Value = True Then
CurrentHours.Copy
newrow.Range(17 + i).PasteSpecial xlPasteValues
End If
If Maint.cells(22, i + 2).Value = True Then
CurrentHours.Copy
newrow.Range(17 + i).PasteSpecial xlPasteValues
End If
Next i
Application.CutCopyMode = False
Dim mp As Range, P As Range 'Copy Current hrs to Equipment Sheet
Set mp = Range("MyPumps")
For Each P In mp
If P.Value = Range("PumpNumber") Then
P.Offset(0, 5).Value = Range("CurrentHours")
End If
Next P
Sheet3.Protect Password:="MyPassword" 'Protect sheets
Sheet5.Protect Password:="MyPassword"
Sheet16.Protect Password:="MyPassword"
Sheet25.Protect Password:="MyPassword"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub