Question

我正在创建一个代码，以便将不同的文件添加到Excel模板中。第一个文件的数据粘贴没有任何问题，但对于第二个文件我做的与第一个文件相同，但是当我运行程序时，上传第二个文件excel失败，因为没有响应。这是代码的一部分，我在每个文件中使用相同的代码，我想要添加到excel模板，第一个“NPS”正常工作，但是对于下一个，如果不崩溃则需要很长时间。反正是为了加快程序速度还是避免程序在运行时崩溃？

Private Sub CommandButton25_Click()

 Application.DisplayAlerts = False
' ########################### 5 pillars dashboard ######################################################################################

' ################## Incident NPS ###########################

Dim wbNewRawData As Workbook


On Error Resume Next

Set wbNewRawData = Workbooks.Open(TextBox20.Value)

'------> adjust path

Set wbTemplate = Workbooks.Open("C:\Users\212462031\Documents\Svcs 5 Pillars Dashboard\Svcs 5 Pillars Dashboard_template.xlsm")

wbNewRawData.Sheets("NPS result-Raw Data_normalized").Visible = True



' copy data
Dim lastrowNewRawData As Double
lastrowNewRawData = wbNewRawData.Sheets("NPS result-Raw Data_normalized").UsedRange.SpecialCells(xlCellTypeLastCell).Row
Application.CutCopyMode = False
wbNewRawData.Sheets("NPS result-Raw Data_normalized").Range("A2:BA" & lastrowNewRawData).Copy
Application.Wait (Now + TimeValue("0:00:01"))
wbTemplate.Sheets("Incident-NPS").Range("A2:BA" & lastrowNewRawData - 1).PasteSpecial Paste:=xlPasteValues
wbTemplate.Sheets("Incident-NPS").Range("A2:BA" & lastrowNewRawData - 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False


'close data file

wbNewRawData.Close savechanges:=False
Dim Filename As String
Filename = "5 Pillars Dashboard_FW" & TextBox29.Value & " " & Mid(TextBox30.Value, 3, 2) & ".xlsm"
wbTemplate.SaveAs (TextBox27.Value & "\" & Filename)

Dim lastrowTemplateC As Double
lastrowTemplateC = wbTemplate.Sheets("Incident-NPS").UsedRange.SpecialCells(xlCellTypeLastCell).Row

' ################# Remote Fix Rate ########################


   Dim RFNewRawData As Workbook

    On Error Resume Next

   Set RFNewRawData = Workbooks.Open(TextBox21.Value)
   Application.DisplayAlerts = False



RFNewRawData.Sheets("BO Raw data").Visible = True


' copy data
Dim lastrowNewRawDataRF As Double
lastrowNewRawDataRF = RFNewRawData.Sheets("BO Raw data").UsedRange.SpecialCells(xlCellTypeLastCell).Row
Application.CutCopyMode = False
RFNewRawData.Sheets("BO Raw data").Range("A2:AG" & lastrowNewRawDataRF).Copy
Application.Wait (Now + TimeValue("0:00:01"))
wbTemplate.Sheets("Remote Fix Raw Data").Range("A2:AG" & lastrowNewRawDataRF).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

'close data file from shared folder
RFNewRawData.Close savechanges:=False

Dim lastrowTemplateS As Double
lastrowTemplateS = wbTemplate.Sheets("Remote Fix Raw Data").UsedRange.SpecialCells(xlCellTypeLastCell).Row

运行宏后Excel没有响应

0 个答案: