各位大神，为何这段代码复制出来的文件都是打不开的？

琴风弦月

1. Sub text()
   
2. Dim i%, j%, p$
   
3. With Application.FileDialog(msoFileDialogFilePicker)
   
4.    
   
5.         If .Show Then
   
6.             p = .SelectedItems(1)
   
7.            
   
8.         Else
   
9.             Exit Sub
   
10.            
    
11.         End If
    
12.     End With
    
13. i = ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Row
    
14. Application.DisplayAlerts = False
    
15. 
    
16. For j = 1 To i
    
17. Set Wb = GetObject(p)
    
18. Wb.SaveCopyAs ThisWorkbook.Path & "" & Range("A" & j).Value & "项目" & ".xlsx"
    
19. Wb.Close False
    
20. Next
    
21. Application.DisplayAlerts = False
    
22. End Sub

复制代码

这段代码要实现的功能是：以BBBBBBBBBB工作簿为模板进行 复制，用新建 Microsoft Excel 工作表A列数据对其进行重命名

abc123281

Sub text()
Dim i%, j%, p$
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
   If .Show Then
      p = .SelectedItems(1)
   Else
      Exit Sub
   End If
End With
i = ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Row

Set Wb = Workbooks.Open(p)
For j = 1 To i
aa = ThisWorkbook.Worksheets("sheet1").Range("A" & j)
Wb.SaveCopyAs ThisWorkbook.Path & "\" & aa & "项目.xlsx"
Next
Wb.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

abc123281

想要复制工作簿  必须先打开才行 workbooks.open(p)

琴风弦月

abc123281 发表于 2018-10-11 23:02
想要复制工作簿  必须先打开才行 workbooks.open(p)

谢谢大神指导

LMY123

琴风弦月 发表于 2018-10-13 11:04
谢谢大神指导

Sub 批量复制文件_参考()
    Path = ThisWorkbook.Path
    For i = 1 To [A1048576].End(3).Row
        FileCopy Path & "\BBBBBBBBBB.xlsx", Path & "\" & Cells(i, 1) & ".xlsx"
    Next
End Sub