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

【问题标题】：Copying sheets to existing workbook, workbook name is cell.value将工作表复制到现有工作簿，工作簿名称为 cell.value
【发布时间】：2019-01-30 20:33:50
【问题描述】：

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

创建新工作表并将其重命名为单元格。范围内的值，如果与宏在同一文件夹中有工作簿（也称为销售单元格.Value），则将此工作表复制到工作簿中；如果没有，请创建一个新工作簿，将其命名为 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) 不断被窃听。有时会说下标超出范围，或者对象不支持此属性或方法。

【问题讨论】：

a) 应该是SheetS(CStr(cell.Value)).Copy（你缺少一个s）b) 你的For Each Sheet In ThisWorkbook 不合适并且没有Next。跨度>

标签： excel vba

【解决方案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 只保证在最后一个工作表之后。}

【讨论】：