Question

我试图从所有已关闭的工作簿中将Range（A14：L26）复制到桌面上的文件中。数据应粘贴到主工作簿中，这是我当前的工作簿。

也仅应粘贴值，而不应粘贴公式或格式。因此，基本上只应粘贴单元格中可见的内容。

这些值应粘贴在表格中，以便以后可视化。

运行代码时，我收到通知，通知Excel无法访问桌面文件夹中的文件，因为它们可能受到保护。

如何通过VBA“取消保护”它们，以便我可以复制数据。

在此方面的任何帮助将不胜感激！

Option Explicit

Sub CopySpecialPaste()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim lRow As Long
Dim ws2 As Worksheet
Dim y As Workbook

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "Choose Target Folder Path"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
myExtension = "*.xlsm*"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

Set y = Workbooks.Open("C:\Users\XXX")
Set ws2 = y.Sheets("Important Information")

'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Copy data on "Important Information" sheet to "Evaluation" Sheet in 
 other workbook

With wb.Sheets("Important Information")
   If WorksheetFunction.CountA(wb.Sheets("Important _ 
    Information").Range("A14:L26")) <> 0 Then
   lRow = .Range("L" & Rows.Count).End(xlUp).Row 'not sure which Range to 
                                                 'add here
   wb.Sheets("Important Information").Range("A14:L26" & lRow).Copy
   ws2.Range("B" & Rows.Count).End(xlUp)(2).PasteSpecial 
   Paste:=xlPasteValues
   Application.CutCopyMode = False
   Else
   End If
End With


wb.Close SaveChanges:=False
'Get next file name
myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "I hope that worked!"

ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

复制和粘贴多个已关闭的工作簿； Excel无法访问数据

0 个答案: