macros从列表错误中复制工作表

我创build了一个macros来创build列表中的工作表，这工作正常，但我有一个问题，如果我只有一个项目列表中出现错误，这里是macros：

Sub CreateSheetsFromAList() Application.ScreenUpdating = False Sheets("Master").Select Sheets("Stock Removal").Visible = True Dim MyCell As Range, MyRange As Range Set MyRange = Sheets("Master").Range("A14") Set MyRange = Range(MyRange, MyRange.End(xlDown)) For Each MyCell In MyRange Sheets("Stock Removal").Copy after:=Sheets(Sheets.Count) 'creates a new worksheet Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet Next MyCell Sheets("Stock Removal").Select ActiveWindow.SelectedSheets.Visible = False Application.ScreenUpdating = True End Sub 

Answer 1

你应该比xlDown使用xlUp更安全！

您之前select了整列（从第14行开始，直到表格末尾）！

这将运行顺利！ ;）

 Sub CreateSheetsFromAList() Application.ScreenUpdating = False Dim wsM As Worksheet, wsSR As Worksheet Dim MyCell As Range, MyRange As Range, LastRow As Double Set wsM = ThisWorkbook.Sheets("Master") Set wsSR = ThisWorkbook.Sheets("Stock Removal") wsM.Select wsSR.Visible = True Set MyRange = wsM.Range("A14") LastRow = wsM.Range("A" & wsM.Rows.Count).End(xlUp).Row If LastRow > 14 Then Set MyRange = Range(MyRange, MyRange.End(xlDown)) For Each MyCell In MyRange wsSR.Copy after:=Sheets(Sheets.Count) 'creates a new worksheet Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet Next MyCell Else wsSR.Copy after:=Sheets(Sheets.Count) 'creates a new worksheet Sheets(Sheets.Count).Name = MyRange.Value ' renames the new worksheet End If wsSR.Select ActiveWindow.SelectedSheets.Visible = False Application.ScreenUpdating = True End Sub 

Answer 2

问题是，如果只有单元格A14有数据，并且整个列A（单元格A14下面）是空的，那么MyRange.End(xlDown)将导致“A1048576”。 所以你需要find列A中的最后一行，然后检查它是否是14 >>如果是，那么你的MyRange应该由1个单元组成，这就是单元格A14。

试试下面的代码来replace你Set MyRange的方式：

 With Sheets("Master") If .Cells(.Rows.Count, "A").End(xlUp).Row = 14 Then ' if only cell A14 has data in entire Column A Set MyRange = Sheets("Master").Range("A14") Else Set MyRange = Sheets("Master").Range("A14", Range("A14").End(xlDown)) End If End With 

Answer 3

尝试改变：

 Set MyRange = Sheets("Master").Range("A14") Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

至：

 With Sheets("Master") Set MyRange = .Range(Range("A14"), .Range("A" & .Range("A" & .Rows.Count).End(xlUp).row)) End With