代码运行的时候，只能复制（金奥文件夹中的）一张表，其他的表复制不了

蔚蓝0827

求助：我用以下代码运行的时候，只能复制（金奥文件夹中的）一张表，其他的表复制不了，提示1004应用程序定以或对象定以错误，请问那个大神能给解决一下，我实在是看不明白怎么回事

Sub ss1()
Dim str As String
Dim i As Integer
Dim vb As Workbook
Dim e, j As Integer   'e是数据源表的最后一行，j是目标表(数据表)的最后一行
Dim sht As Worksheet
Application.DisplayAlerts = False
For Each sht In Sheets
   If file:///C:\Users\kinghand\AppData\Roaming\Tencent\QQTempSys\%W@GJ$ACOF(TYDYECOKVDYB.pngsht.Name <> "Sheet1" Then
   sht.Delete
   End If
Application.DisplayAlerts = True
Next

str = Dir("C:\财务工作\财务工作\11.与刘洋相关\20230630财务报表\金奥\*.xls*")
For i = 1 To 100
Set vb = Workbooks.Open("C:\财务工作\财务工作\11.与刘洋相关\20230630财务报表\金奥\" & str)
vb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(file:///C:\Users\kinghand\AppData\Roaming\Tencent\QQTempSys\%W@GJ$ACOF(TYDYECOKVDYB.pngvb.Name, ".")(0)
vb.Close
str = Dir
If str = "" Then
Exit For
End If
Next
Sheet1.Delete
MsgBox "已处理完毕"
End Sub

蔚蓝0827

Sub ss1()
Dim str As String
Dim i As Integer
Dim vb As Workbook
Dim e, j As Integer   'e是数据源表的最后一行，j是目标表(数据表)的最后一行
Dim sht As Worksheet
Application.DisplayAlerts = False
For Each sht In Sheets
   If sht.Name <> "Sheet1" Then
   sht.Delete
   End If
Application.DisplayAlerts = True
Next

str = Dir("C:\财务工作\财务工作\11.与刘洋相关\20230630财务报表\金奥\*.xls*")
For i = 1 To 100
Set vb = Workbooks.Open("C:\财务工作\财务工作\11.与刘洋相关\20230630财务报表\金奥\" & str)
vb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(vb.Name, ".")(0)
vb.Close
str = Dir
If str = "" Then
Exit For
End If
Next
Sheet1.Delete
MsgBox "已处理完毕"
End Sub

Peny2020

报错不是可以点Debug吗，看哪句变黄了就可以查原因

ykcbf1100

这个应该是Ai写的代码，人类应该不会这么写的。
没有附件，也无法看起。

LIUZHU

蔚蓝0827 发表于 2023-7-10 16:36
Sub ss1()
Dim str As String
Dim i As Integer

vb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
这句又问题吧
改成vb.Sheets(i).Copy 试试

蔚蓝0827

LIUZHU 发表于 2023-7-10 18:15
vb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
这句又问题吧
改成vb.Shee ...

不行，试过了我怀疑是原始数据是XLSX格式的问题，但该怎么修改 不太清楚，您知道么，现在只能复制其中的一个文件里sheet

蔚蓝0827

Peny2020 发表于 2023-7-10 17:20
报错不是可以点Debug吗，看哪句变黄了就可以查原因

没有变黄的，现在能复制一个表进去，其他的就复制不了了，我感觉是原始数据XLSX的问题，但是怎么修改，我不太会

Peny2020

蔚蓝0827 发表于 2023-7-11 09:54
没有变黄的，现在能复制一个表进去，其他的就复制不了了，我感觉是原始数据XLSX的问题，但是怎么修改，我 ...

str = Dir("C:\财务工作\财务工作\11.与刘洋相关\20230630财务报表\金奥\*.xls*")
For i = 1 To 100
Set vb = Workbooks.Open("C:\财务工作\财务工作\11.与刘洋相关\20230630财务报表\金奥\" & str)
vb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(vb.Name, ".")(0)

你这段是在金奥文件里有N 个文件 ，然后文件名和sheet名都是一样的？
还是说你指定了sheet名字而你的数据源又没按这个规定来命名？
那你看看是不是数据源里出现了不一样导致复制不了。
*.xls*应该包括了xlsx的文件的。
你没法上传附件，只能靠猜了。