Excel VBA：打开文件、计算、粘贴值、重复

我正在尝试编写一个宏，该宏将在提供的目录中逐个打开文件，计算所有公式，将值粘贴到特定公式上，保存并退出，对下一个文件重复该过程。以下是我的资料：

Sub LoopPaloSnapshot()

Dim wb As Workbook
Dim ws As Worksheet
Dim MyPath As String
Dim FldrPicker As FileDialog
Dim FSO As New FileSystemObject
Dim MyFolder As Folder
Dim SubFolder As Folder
Dim MyFile2 As File

Application.ScreenUpdating = True
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

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

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

Set FSO = CreateObject("scripting.filesystemobject")


'In Case of Cancel
NextCode:

MyPath = MyPath

Set MyFolder = FSO.GetFolder(MyPath)

For Each SubFolder In MyFolder.SubFolders

For Each MyFile2 In SubFolder.Files


If FSO.GetExtensionName(MyFile2.Path) = "xlsx" Then

    Set wb = Workbooks.Open(Filename:=MyFile2, UpdateLinks:=0)

    Set ws = wb.Worksheets("Staffing Model")

       Application.Run ("PALO.CALCSHEET")
       Application.Calculate
       Application.Run ("PALO.CALCSHEET")
       Application.Calculate

    Application.Calculation = xlCalculationManual

        ws.Range("B1").Select
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F10:Q10").Value = ws.Range("F10:Q10").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F20:Q22").Value = ws.Range("F20:Q22").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F42:Q43").Value = ws.Range("F42:Q43").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F56:Q56").Value = ws.Range("F56:Q56").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F61:Q61").Value = ws.Range("F61:Q61").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False
        ws.Range("F66:Q66").Value = ws.Range("F66:Q66").Value
         Selection.Copy
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
SkipBlanks _
         :=False, Transpose:=False

'Break Links
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
    wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
    End If

Dim xWs As Worksheet
For Each xWs In Application.ActiveWorkbook.Worksheets
    If xWs.Name <> "Staffing Model" Then
        xWs.Delete
    End If
Next

    'Save and Close Workbook
    wb.Close SaveChanges:=True

'Loop

End If

Next
Next

MsgBox "Task Complete!"

ResetSettings:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub

Sub-LoopPaloSnapshot（）
将wb设置为工作簿
将ws设置为工作表
将MyPath设置为字符串
Dim FldrPicker As FILE对话框
将FSO设置为新的FileSystemObject
将MyFolder设置为文件夹
将子文件夹变暗为文件夹
将MyFile2设置为文件
Application.ScreenUpdating=True
Application.EnableEvents=False
Application.DisplayAlerts=False
Application.Calculation=xlCalculationManual
'从用户检索目标文件夹路径
Set FldrPicker=Application.FileDialog（msoFileDialogFolderPicker）
用FldrPicker
.Title=“选择目标文件夹”
.AllowMultiSelect=False
如果.Show-1，则转到下一个代码
MyPath=.SelectedItems（1）和“\”
以
设置FSO=CreateObject（“scripting.filesystemobject”）
"如果取消,
下一个代码：
MyPath=MyPath
设置MyFolder=FSO.GetFolder（MyPath）
对于MyFolder.SubFolders中的每个子文件夹
对于子文件夹.Files中的每个MyFile2
如果FSO.GetExtensionName（MyFile2.Path）=“xlsx”，则
设置wb=Workbooks.Open（文件名：=MyFile2，UpdateLinks:=0）
设置ws=wb.工作表（“人员配置模型”）
Application.Run（“PALO.CALCSHEET”）
应用。计算
Application.Run（“PALO.CALCSHEET”）
应用。计算
Application.Calculation=xlCalculationManual
ws.Range（“B1”）。选择
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，
滑雪板_
：=假，转置：=假
ws.范围（“F10:Q10”）.值=ws.范围（“F10:Q10”）.值
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，
滑雪板_
：=假，转置：=假
ws.Range（“F20:Q22”）.Value=ws.Range（“F20:Q22”）.Value
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，
滑雪板_
：=假，转置：=假
ws.Range（“F42:Q43”）.Value=ws.Range（“F42:Q43”）.Value
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，
滑雪板_
：=假，转置：=假
ws.Range（“F56:Q56”）.Value=ws.Range（“F56:Q56”）.Value
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，
滑雪板_
：=假，转置：=假
ws.Range（“F61:Q61”）.Value=ws.Range（“F61:Q61”）.Value
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，
滑雪板_
：=假，转置：=假
ws.Range（“F66:Q66”）.Value=ws.Range（“F66:Q66”）.Value
选择，复制
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，
滑雪板_
：=假，转置：=假
"断链",
如果不是空的（wb.LinkSources（xlExcelLinks）），那么
对于wb.LinkSources（xlExcelLinks）中的每个链接
wb.BreakLink链接，xlLinkTypeExcelLinks
下一环节
如果结束
将xWs设置为工作表
对于Application.ActiveWorkbook.Worksheets中的每个xWs
如果xWs.Name为“人员配置模型”，则
删除
如果结束
下一个
'保存并关闭工作簿
wb.Close SaveChanges:=真
'循环
如果结束
下一个
下一个
MsgBox“任务完成！”
重置设置：
Application.ScreenUpdating=True
Application.EnableEvents=True
Application.DisplayAlerts=True
Application.Calculation=xlCalculationAutomatic
端接头

运行此命令后，我打开了新保存的文件，在我试图计算和粘贴值的公式中出现了#值错误。我试着一行一行地遍历宏，它在大多数情况下似乎工作正常，但由于某些原因，公式无法计算。如果我在运行宏之前手动打开该文件，所有内容都能完美计算，因此我想知道是什么原因导致宏运行时这些公式无法计算。任何帮助都将不胜感激

---

编辑：我复制和粘贴值的公式是HLOOKUP从工作簿中的其他选项卡提取的，PALO公式直接从JEDOX服务器提取数据。我已经手动运行了我试图自动执行的过程，没有错误。

我建议使用以下方法将公式直接写入单元格，而不是复制和粘贴复杂的公式：

Worksheets("Sheet1").Range("A1").Formula = "=$A$4+$A$10"

粘贴的公式有时会引用原始工作表，这会导致混乱，而显式设置的公式则不会这样做

如果你真的想让它离线，那么你也可以使用这个方法来设置值

Worksheets("Sheet1").Range("A1").Value = "100"

---

请您添加更多关于您正在复制和粘贴的内容的详细信息，好吗？这可能就是错误所在。@Graham真棒的名字！我添加了一个编辑。我希望这会有帮助。很乐意帮忙，保重。我不明白。公式已在我选择的单元格中。这个宏的目的是准备将文件发送到他们无法访问数据服务器的字段。实际上，我想我已经修复了它。我录了一个很小的宏来偷懒，在复制和粘贴时很粗心。。。。谢谢你的回复。它无意中帮助我意识到了这一点。我不得不用Essbase和Excel来做这件事，在我转向显式方法之前，我遇到了完全相同的问题。