我已经创建了一个宏,可以根据需要复制/粘贴。但是,我最近意识到我需要取消隐藏所需的工作表,并用VBA取消保护我的工作簿。整个工作簿都需要用密码保护,而不仅仅是一张纸。当我使用Workbook.Unprotect Password:="SOCKS"
运行代码时,出现运行时错误'424'。
Sub CopyRange()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Integer
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim strExtension As String
Dim LastRow As Long
Dim a As Integer
Const strPath As String = "H:\My Documents\Timesheet Folder\" 'Specify file path here next to the = in the " "
ChDir strPath
strExtension = Dir(strPath & "*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath & strExtension)
With wkbSource.Sheets("Data") 'Specify the name of the sheet here in the " " next to .Sheets
a = .Cells(.Rows.Count, 1).End(xlUp).Row
Worksheets("Data").Visible = True
Workbook.Unprotect Password:="SOCKS" 'Here is the problem line
For i = 1 To a
If .Cells(i, 1).Value = "1934001" And .Cells(i, 2).Value = "GSMP_North_Haledon" And .Cells(i, 4).Value = "2019" And .Cells(i, 5).Value = "September" And .Cells(i, 6).Value = "20" And .Cells(i, 17).Value = "SRo" Then
'In the line below, name the sheet of the open destination workbook in the " " next to .Worksheets
LastRow = wkbDest.Worksheets("Data").Cells(wkbDest.Worksheets("Data").Rows.Count, "B").End(xlUp).Offset(1).Row
Worksheets("Data").Range(Worksheets("Data").Cells(i, 1), Worksheets("Data").Cells(i, 17)).Copy
wkbDest.Worksheets("Data").Range("B" & LastRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
Next
End With
wkbSource.Close savechanges:=False
strExtension = Dir
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
答案 0 :(得分:2)
该行的资格不正确,请尝试以下操作:
wkbSource.Unprotect Password:="SOCKS"
答案 1 :(得分:2)
您需要将Workbook
替换为您要unprotect
的实际工作簿对象。我假设它的wbkSource
。