时间戳

首页 > 解决方案 > VBA - 通过现有列表复制工作表直到列表末尾

excel - VBA - 通过现有列表复制工作表直到列表末尾

问题描述

我创建了一个 VBA 代码，该代码在最后一个代码上失败。

我通过网站源获得了这段代码。

这是描述：

  1. 表“天行者”是来自系统的数据。
  2. 表“生成”是通过已经设置的公式来检查需要报表出具的金额列表。
  3. B3 上的“生成”表是要按下的按钮的位置（绿色）。阅读Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet宏失败后。

这是代码和模板示例

示例模板 https://drive.google.com/drive/folders/1GWqOfZFpiay0NVP-mXQfjGEc4UEqCzKn?usp=sharing

Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range


Set MyRange = Sheets(4).Range("C6")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
Sheets(5).Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell


Application.ScreenUpdating = False


End Sub

我需要做什么才能使宏不调试？

宏完成后我需要一个消息框。

我真的很感谢你的帮助。TQ

对不起我的英语不好。

标签： excelvba

解决方案

只是为了搭载 Harun24HR 的代码，我会添加一个 Goto 语句而不是“Exit Sub”。提供的列表有 8 行（第 6-13 行）值，其余为空值。如果存在第 14 行为空而第 15 行有值的情况怎么办？因此，我们希望使用 Goto 语句来处理这种情况。

以下是Harun24HR修改后的代码：

Sub CreateSheetsFromAList()

Dim MyCell As Range, MyRange As Range

    Set MyRange = Sheets(4).Range("C6")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    
    Application.ScreenUpdating = False
    For Each MyCell In MyRange
        If MyCell.Value = "" Then 'Check for null/empty value cell.
            GoTo NextOne: 'Go to next MyCell
        Else
            Sheets(5).Copy After:=Sheets(Sheets.count) 'creates a new worksheet
            Sheets(Sheets.count).Name = MyCell.Value ' renames the new worksheet
        End If NextOne:
    Next MyCell
    Application.ScreenUpdating = True
    MsgBox "Macro is done" 'Insert your own message between the quotations. 
End Sub

推荐阅读