Question

这里很新。尝试调试时遇到困难。我目前正在尝试使宏按以下方式工作：

创建新工作表并将其重命名为单元格。值范围内，并且如果在与宏相同的文件夹中有一个工作簿（也称为销售单元。值），则将此工作表复制到该工作簿中；如果不是，请创建一个新工作簿，将其命名为cell.Value，然后将工作表复制到该新工作簿中。

将工作表复制到现有工作簿部分时遇到麻烦：我猜这是我输入工作簿名称的方式吗？

Sub SplitandFilterSheet()

Sheet2.Activate

Dim Splitcode As Range

Set Splitcode = Range("Splitcode2")

'Use each cell in Splitcode to name each newly copied worksheet

For Each cell In Splitcode
Sheets("Realized").Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = cell.Value

'In each newly created worksheet, filter ParentID by the worksheet name (for example, 004), and then fill in color in those cells

With ActiveWorkbook.Sheets(CStr(cell.Value)).Range("MasterData2")
.AutoFilter Field:=2, Criteria1:="=" & CStr(cell.Value), Operator:=xlFilterValues
.Offset(1, 0).Interior.ColorIndex = 5

'Unfilter

ActiveSheet.AutoFilter.ShowAllData

'Now filter ParentID cells that do not have color (i.e. anything that is not 004, since rowsa where ParentID=004 has color) and then delete

.AutoFilter Field:=2, Operator:=xlFilterNoFill
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete

'Unfilter, make color as blank, and rename sheet with Realize or Unrealized

ActiveSheet.AutoFilter.ShowAllData
.Offset(1, 0).Interior.ColorIndex = 0


Dim FilePath As String, wb As Workbook

    FilePath = ""
    On Error Resume Next
    FilePath = Dir("C:\Users\hsush001\Downloads\test\" & cell.Value & ".xlsx")
    On Error GoTo 0
    If FilePath = "" Then
    ActiveWorkbook.SaveAs Filename:="C:\Users\hsush001\Downloads\test\" & cell.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close SaveChanges:=False

    Else
    Set wb = Workbooks.Open("C:\Users\hsush001\Downloads\test\" & cell.Value & ".xlsx")
    For Each Sheet In ThisWorkbook
    Sheet(CStr(cell.Value)).Copy After:=wb.Sheets(wb.Sheets.Count)
    wb.Saved = True
    wb.Close SaveChanges:=False
End With

Next cell
MsgBox "Macro Completed"

End Sub

此行：Sheet(CStr(cell.Value)).Copy After:=wb.Sheets(wb.Sheets.Count)不断出错。.有时说下标超出范围，或者对象不支持此属性或方法。

Answer 1

Sheet(CStr(cell.Value)).Copy After:=wb.Sheets(wb.Sheets.Count)

Sheet被分配并通过ThisWorkbook作为单个工作表进行迭代。您想要按名称标识ThisWorkbook.Worksheets集合¹中的工作表之一。

'bunch of code
Set wb = Workbooks.Open("C:\Users\hsush001\Downloads\test\" & cell.Value & ".xlsx")
ThisWorkbook.Worksheets(cell.Value).Copy After:=wb.Sheets(wb.Sheets.Count)
wb.Close SaveChanges:=True
'more code

For Each Sheet In ThisWorkbook没有实际作用，并且缺少其Next Sheet来关闭循环。

¹_{我更喜欢在Worksheets集合中工作，而不是在Sheets集合中工作，但是您可以使用后者。在这种情况下，这只是个人选择。但是 after：= Sheets.Count 保证队列结束，而 after：= WorksSheets.Count 仅保证最后一个工作表之后。}

将工作表复制到现有工作簿，工作簿名称为cell.value

1 个答案: