VBA BUG:copy method of worksheet class failed,代码为temp_wb.Sheets("Order Entry Form").Copy after:=temp_wb.Sheets(temp_wb.Sheets.Count
时间: 2024-05-13 08:15:46 浏览: 9
这个问题可能是因为工作簿中的工作表名称包含特殊字符或长度超出了 Excel 的最大长度限制。我建议您尝试以下解决方案:
1.尝试使用另一个名称为 "Order Entry Form" 的工作表进行复制,确保工作表名称没有特殊字符。
2.如果您的工作表名称超出了 Excel 的最大长度限制,请尝试缩短工作表名称,以确保名称不超过 31 个字符。
3.在复制工作表之前,您可以尝试将工作表的可见性设置为 True,以确保工作表是可见的。您可以使用以下代码:
```
temp_wb.Sheets("Order Entry Form").Visible = True
temp_wb.Sheets("Order Entry Form").Copy after:=temp_wb.Sheets(temp_wb.Sheets.Count)
```
希望这些解决方案可以帮助您解决问题!
相关问题
优化这段vba代码: set lo = worksheet.listobject()
我可以给出以下优化建议:
1. 使用明确的worksheet名称,而不是隐式引用ActiveSheet,这可以提高代码可读性和稳定性。
2. 在定义变量时,尽可能使用具体的类型,例如使用ListObject代替Object。
3. 在使用ListObject之前,确保worksheet中存在ListObject。可以使用ListObjects属性来检查。
下面是优化后的代码:
```
Dim ws As Worksheet
Dim lo As ListObject
Set ws = ThisWorkbook.Worksheets("Sheet1")
If ws.ListObjects.Count > 0 Then
Set lo = ws.ListObjects(1)
End If
```
这个代码段首先定义了一个Worksheet变量,然后检查worksheet中是否存在任何ListObject。如果存在,则使用第一个ListObject,否则将lo设置为Nothing。这样可以避免出现运行时错误。
请为以下代码的每一句写上注释。Sub CopySameDay() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim copyRange As Range Dim pasteRange As Range Dim wb As Workbook Dim folderPath As String Dim fileName As String Dim sumRange As Range Dim sumValue As Double Set ws = ActiveSheet lastRow = ws.Cells(Rows.Count, "D").End(xlUp).Row For i = 2 To lastRow If Format(ws.Range("D" & i).Value, "yyyy-mm-dd") = Format(ws.Range("D" & i - 1).Value, "yyyy-mm-dd") And ws.Range("B" & i).Value = ws.Range("B" & i - 1).Value Then If copyRange Is Nothing Then Set copyRange = ws.Range("A" & i - 1) End If Set pasteRange = ws.Range("A" & i) Else If Not copyRange Is Nothing Then folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) fileName = pasteRange.Offset(0, 1).Value & ".xlsx" If Dir(folderPath & fileName) = "" Then Set wb = Workbooks.Add wb.SaveAs folderPath & fileName Else Set wb = Workbooks.Open(folderPath & fileName) End If wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd") Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2)) sumValue = Application.WorksheetFunction.Sum(sumRange) wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2)).NumberFormat = "0.00" copyRange.Resize(i - copyRange.Row, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2") wb.Sheets(wb.Sheets.Count).Range("K" & (i - copyRange.Row + 2)).Value = sumValue ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1") wb.Save wb.Close Set copyRange = Nothing End If End If Next i If Not copyRange Is Nothing Then folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) fileName = pasteRange.Offset(0, 1).Value & ".xlsx" If Dir(folderPath & fileName) = "" Then Set wb = Workbooks.Add wb.SaveAs folderPath & fileName Else Set wb = Workbooks.Open(folderPath & fileName) End If wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd") Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3)) sumValue = Application.WorksheetFunction.Sum(sumRange) wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3)).NumberFormat = "0.00" copyRange.Resize(lastRow - copyRange.Row + 1, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2") wb.Sheets(wb.Sheets.Count).Range("K" & (lastRow - copyRange.Row + 3)).Value = sumValue ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1") wb.Save wb.Close End If End Sub
注释如下:
```VBA
Sub CopySameDay()
' 定义变量
Dim ws As Worksheet ' 工作表
Dim lastRow As Long ' 最后一行
Dim i As Long ' 循环计数变量
Dim copyRange As Range ' 复制区域
Dim pasteRange As Range ' 粘贴区域
Dim wb As Workbook ' 工作簿
Dim folderPath As String ' 文件夹路径
Dim fileName As String ' 文件名
Dim sumRange As Range ' 求和区域
Dim sumValue As Double ' 求和结果
' 获取当前活动工作表
Set ws = ActiveSheet
' 获取最后一行
lastRow = ws.Cells(Rows.Count, "D").End(xlUp).Row
' 循环遍历行
For i = 2 To lastRow
' 判断是否为同一天且同一人
If Format(ws.Range("D" & i).Value, "yyyy-mm-dd") = Format(ws.Range("D" & i - 1).Value, "yyyy-mm-dd") And ws.Range("B" & i).Value = ws.Range("B" & i - 1).Value Then
' 如果是,设置复制区域和粘贴区域
If copyRange Is Nothing Then
Set copyRange = ws.Range("A" & i - 1)
End If
Set pasteRange = ws.Range("A" & i)
Else
' 如果不是,进行复制和粘贴操作
If Not copyRange Is Nothing Then
' 获取文件夹路径和文件名
folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\"))
fileName = pasteRange.Offset(0, 1).Value & ".xlsx"
' 判断文件是否存在,不存在则新建,存在则打开
If Dir(folderPath & fileName) = "" Then
Set wb = Workbooks.Add
wb.SaveAs folderPath & fileName
Else
Set wb = Workbooks.Open(folderPath & fileName)
End If
' 在工作簿中添加新的工作表
wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd")
' 获取求和区域和求和结果
Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2))
sumValue = Application.WorksheetFunction.Sum(sumRange)
' 设置求和区域的数字格式
wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2)).NumberFormat = "0.00"
' 复制数据到新的工作表中
copyRange.Resize(i - copyRange.Row, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2")
' 将求和结果写入新的工作表中
wb.Sheets(wb.Sheets.Count).Range("K" & (i - copyRange.Row + 2)).Value = sumValue
' 将表头复制到新的工作表中
ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1")
' 保存工作簿并关闭
wb.Save
wb.Close
' 清空复制区域
Set copyRange = Nothing
End If
End If
Next i
' 如果仍有复制区域,进行最后一次复制和粘贴操作
If Not copyRange Is Nothing Then
' 获取文件夹路径和文件名
folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\"))
fileName = pasteRange.Offset(0, 1).Value & ".xlsx"
' 判断文件是否存在,不存在则新建,存在则打开
If Dir(folderPath & fileName) = "" Then
Set wb = Workbooks.Add
wb.SaveAs folderPath & fileName
Else
Set wb = Workbooks.Open(folderPath & fileName)
End If
' 在工作簿中添加新的工作表
wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd")
' 获取求和区域和求和结果
Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3))
sumValue = Application.WorksheetFunction.Sum(sumRange)
' 设置求和区域的数字格式
wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3)).NumberFormat = "0.00"
' 复制数据到新的工作表中
copyRange.Resize(lastRow - copyRange.Row + 1, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2")
' 将求和结果写入新的工作表中
wb.Sheets(wb.Sheets.Count).Range("K" & (lastRow - copyRange.Row + 3)).Value = sumValue
' 将表头复制到新的工作表中
ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1")
' 保存工作簿并关闭
wb.Save
wb.Close
End If
End Sub
```