Performance 在VBA中优化从一个工作簿到另一个工作簿的复制和粘贴

我在一个文件夹中有几个.xlsm模板。我正在尝试读取该文件夹中的所有excel文件，根据文件类型，它将读取每个文件中的所有工作表，并将特定单元格复制到另一个我的活动工作簿（ThisWorkbook）中。 下面是我的代码，它工作正常。然而它是超慢的。我正在寻找任何可以加快代码速度的解决方案。我已经尝试过Application.screenUpdate=False，但仍然非常慢。处理20个文件大约需要10分钟。 你们对如何提高速度有什么建议吗。 事先谢谢Veru mich

Application.ScreenUpdating=True

---

…

我刚刚意识到，性能低下是由于excel中编写的公式，但这些公式与从宏代码粘贴的范围相关联。正如前面的堆栈溢出解决方案中所述，我只是在代码的开头添加了“Application.Calculation=xlCalculationManual”，在代码的末尾添加了“Application.Calculation=xlCalculationAutomatic”，现在速度快多了

---

我希望这本书对正在阅读本书的人也有用

您的设置涉及多少行的多少张纸？谢谢您的回复。根据文件的不同，每个工作簿有1到20个工作表。每张纸上没有多少东西可以复制。每张图纸最多可复制10个单独的单元格。

    Application.ScreenUpdating = False
    FileType = "*.xls*"     
    OutputRow = 5   
    Range("$B$6:$M$300").ClearContents
    filepath = Range("$B$3") & "\" 

    ThisWorkbook.ActiveSheet.Range("B" & OutputRow).Activate
    OutputRow = OutputRow + 1
    Curr_File = Dir(filepath & FileType)
    Do Until Curr_File = ""
        Set FldrWkbk = Workbooks.Open(filepath & Curr_File, False, True)
        ThisWorkbook.ActiveSheet.Range("B" & OutputRow) = Curr_File
        OutputRow = OutputRow

        For Each sht In FldrWkbk.Sheets
            ThisWorkbook.ActiveSheet.Range("C" & OutputRow) = sht.Name
            If Workbooks(Curr_File).Worksheets(sht.Name).Range("B7") = "Project Number" Then
             For i = 1 To 4
              If IsEmpty(Workbooks(Curr_File).Worksheets(sht.Name).Cells(10, 5 + 2 * i)) = False Then
                With Workbooks(Curr_File).Worksheets(sht.Name)
                   MyE = .Cells(10, 5 + 2 * i).Value
                   MyF = .Cells(11, 5 + 2 * i).Value
                End With
                With ThisWorkbook.ActiveSheet
                  .Range("D" & OutputRow).Value = "Unit Weight"
                  .Range("E" & OutputRow).Value = MyE
                  .Range("F" & OutputRow).Value = MyF
                End With
                OutputRow = OutputRow + 1
              End If
             Next
            OutputRow = OutputRow - 1
            ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("C6") = "PROJECT NUMBER" Then
             With Workbooks(Curr_File).Worksheets(sht.Name)
                   MyE = .Range("$H$9").Value
                   MyF = .Range("$B$9").Value

             End With
             With ThisWorkbook.ActiveSheet
            .Range("D" & OutputRow).Value = "Specific Gravity"
            .Range("E" & OutputRow).Value = MyE
            .Range("F" & OutputRow).Value = MyF
            End With

            ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("C6") = "Project Number" Then

            With Workbooks(Curr_File).Worksheets(sht.Name)
                   MyE = .Range("$E$4").Value
                   MyF = .Range("$R$4").Value
                   MyG = .Range("$R$5").Value
             End With
             With ThisWorkbook.ActiveSheet
             .Range("D" & OutputRow).Value = "Sieve & Hydrometer"
             .Range("E" & OutputRow).Value = MyE
             .Range("F" & OutputRow).Value = MyF
             .Range("G" & OutputRow).Value = MyG
            End With

            ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("A6") = "PROJECT NUMBER" Then
            ThisWorkbook.ActiveSheet.Range("D" & OutputRow).Value = "Moisture Content"

            Last = Workbooks(Curr_File).Worksheets(sht.Name).Cells(Rows.Count, "J").End(xlUp).Row
            ThisWorkbook.ActiveSheet.Range("I" & OutputRow).Value = 
            Workbooks(Curr_File).Worksheets(sht.Name).Cells(Last, 10)

            ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("C5") = "Project Number" Then
            With Workbooks(Curr_File).Worksheets(sht.Name)
                   MyE = .Range("$H$8").Value
                   MyF = .Range("$B$8").Value
                   MyG = .Range("$D$8").Value
             End With
             With ThisWorkbook.ActiveSheet
             .Range("D" & OutputRow).Value = "Atterberg Limits"
             .Range("E" & OutputRow).Value = MyE
             .Range("F" & OutputRow).Value = MyF
             .Range("G" & OutputRow).Value = MyG
             End With

            ElseIf Workbooks(Curr_File).Worksheets(sht.Name).Range("B5") = "Project Number" Then
            With Workbooks(Curr_File).Worksheets(sht.Name)
                   MyE = .Range("$G$4").Value
                   MyF = .Range("$E$4").Value
                   MyG = .Range("$E$5").Value
            End With
            With ThisWorkbook.ActiveSheet
             .Range("D" & OutputRow).Value = "Gradation Size"
             .Range("E" & OutputRow).Value = MyE
             .Range("F" & OutputRow).Value = MyF
             .Range("G" & OutputRow).Value = MyG
             End With
            End If
            OutputRow = OutputRow + 1
        Next sht
        FldrWkbk.Close SaveChanges:=False
        Curr_File = Dir
    Loop
    Set FldrWkbk = Nothing