我已经正常生成了一个summary文件和N个Map文件，都是EXCEL文件，现要求生成一个新的EXCEL文件，把Summary文件内容copy到新文件的Sheet1位置，其他的MAP文件按照顺序依次拷贝的新excel文件中，程序我也编写了，但现在问题是编译后在十次里面偶尔会出现一两次Sheet1位置为空白，也就是Summary文件内容没有copy到新文件的Sheet1位置，其他MAP文件倒是都拷贝进去了，这是怎么回事呢？麻烦帮看看我的程序里有什么问题吧？谢谢大家了！！

If Dir(Dir1.Path & "\合并导出", vbDirectory) = "" Then MkDir Dir1.Path & "\合并导出" '如果不存在文件夹则创建之

If Dir(Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx") = "" Then
    Set XlApp = CreateObject("Excel.Application")
    Set xlBook = XlApp.Workbooks.Add
    XlApp.Visible = False
    Set xlsheet = xlBook.Worksheets(3)
    XlApp.ScreenUpdating = False  '屏幕更新关

xlBook.SaveAs (Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")

xlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
XlApp.Quit
Set XlApp = Nothing  '注意：xlApp要先Quit，后Nothing
End If


    Set XlApp = CreateObject("Excel.Application")
    Set xlBook = XlApp.Workbooks.Add

    XlApp.DisplayAlerts = False '不显示对话框
    Set newBook2 = XlApp.Workbooks.Open(Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")
    Set newBook4 = XlApp.Workbooks.Open(Dir1.Path & "\SUMMARY.xlsx")
     newBook2.Worksheets("Sheet3").Delete
     newBook2.Worksheets("Sheet2").Delete

    newBook4.Sheets("sheet1").Name = "统计信息"
    newBook4.Sheets("统计信息").Copy after:=newBook2.Sheets(newBook2.Sheets.Count)

    For i = 0 To File2.ListCount - 1
    
    Set newBook1 = XlApp.Workbooks.Open(Dir1.Path & "\封装图导出\" & File2.List(i))
    newBook1.Sheets(1).Copy after:=newBook2.Sheets(newBook2.Sheets.Count)

 
    newApp.Visible = False
    
    
    Next i
    


 newBook2.Worksheets("Sheet1").Delete

 newBook2.SaveAs (Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")

 

 

 xlBook.SaveAs (Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")
'在退出窗体前，释放excel相应变量


 
    newApp.Visible = False
     XlApp.DisplayAlerts = False '不显示对话框
   
    Set newBook1 = Nothing
    Set newBook2 = Nothing
    Set newBook3 = Nothing
    Set newBook4 = Nothing

Set newApp = Nothing
xlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
XlApp.Quit
Set XlApp = Nothing 

没有谁能帮我一下吗？

1、程序增加一个延时函数
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Sub sleep(seconds As Integer)
Dim temp As Variant
temp = timeGetTime
  While timeGetTime - seconds < temp
  DoEvents
  Wend
End Sub
2、执行 newBook4.Sheets("统计信息").Copy后调用延时函数
  call sleep（1000）'这个是延时1秒。
 
  我认为你执行copy命令后，数据没有copy成功，就执行了保存操作。
  而且数据量越大，应该空白的越多，你自己测试一下。