Question

请增加自动提取工作表名称的VBA代码

满财富求多工作表自动求和以及汇总的VBA代码。
我有一个工作薄，下有很多个工作表，想将工作表中指定单元格的数字部分自动求和到汇总表，工作表中b54:ao200内容（有多有少）按照顺序提取到汇总表中，并在每一行的前面注明工作表名称，请达人帮忙，谢谢

Sub huizong()
ActiveSheet.Range("b54:ao200").ClearContents '清除b54:ao200内容
Dim sh As Worksheet
For Each sh In Sheets
If InStr(sh.Name, "汇总") = 0 Then
With sh
r = .Cells(Rows.Count, 8).End(3).Row
r2 = Sheets("汇总").Cells(Rows.Count, 8).End(3).Row
.Range("a54:ao" & r).Copy Sheets("汇总").Range("a" & r2 + 1)
End With
End If
Next
End Sub

Answer 1

Sub huizong()
    ActiveSheet.Range("b54:ao200").ClearContents '清除b54:ao200内容
    Dim sh As Worksheet,r,r2
    For Each sh In Sheets
        If InStr(sh.Name, "汇总") = 0 Then
            With sh
                r = .Cells(Rows.Count, 8).End(3).Row
                r2 = Sheets("汇总").Cells(Rows.Count, 8).End(3).Row
                Sheets("汇总").Range("a" & r2 + 1).resize(r-53,1) = .name
                .Range("a54:ao" & r).Copy Sheets("汇总").Range("b" & r2 + 1)
            End With
        End If
    Next
End Sub

追问

用不来，第9行错误

追答

报错界面拷屏

追问

追答

语句没有问题，此时r值为多少？
此时的r值是当前汇总工作表H列最后一个非空行的行号，下面要复制A:AO列从54行到这一行的区域到汇总表中，如果此时r比54小，下面的代码也是有问题的，必须调整程序逻辑，明白了么？
简单避免语句报错，可以把报错行修改为：
Sheets("汇总").Range("a" & r2 + 1).resize(iif(r<54,1,r-53),1) = .name
如果你不知道正确应该怎么修改，那就这样修改吧，解决我添加的语句不报错。

追问

点击控件时，能够看到工作表名称，但是是一闪而过，不会注明工作表名称，这是怎么回事呢

追答

麻烦你拷屏上个图好不好。让我们看见你有没有名字里面不含有【汇总】的表，是否能生成数据，生成的数据是否在B列，如果还是在A列里面，说明你是用的原来的代码，没有按照我的代码进行修改（第10行我修改结果存放在B列）

追问

这是复制您的代码，好多工作表内容都不在的

追答

看起来没有问题呀，表名复制在A列、数据粘贴到B列开始，你按F8单步执行，仔细感受每一行语句的变化吧，我真没有发现有问题。

另外，我很不习惯小问题讨论这么多个回合，如果愿意可以【百度云盘】（一个使用百度账户登录的可以对话和传送文件的应用）发文件给我，我做好了回你。

Answer 2

你要提取sheet名？很简单，一个循环就搞定了

Answer 3

不懂不是这专业

Answer 4

ActiveSheet.Range("b54:ao200").ClearContents '清除b54:ao200内容