Question

EXCEL编程中提示"缺少End Sub"是什么问题?在网上找的程序，写进去为什么出现“缺少End Sub”?求解啊。。

Sub hebingbiao()
' Macro1 Macro
' 将多个工作表数据合并到新表中

Dim objSheet As Worksheet
Dim objNew As Worksheet
Dim intRow As Long
Dim rowEnd As Long
Sheets.Add After:=Sheets(Sheets.Count)
Set objNew = Sheets(Sheets.Count)
ActiveSheet.Name = "合并销售表"
intRow = 1
For i = 1 To Sheets.Count - 1
Set objSheet = Sheets(4)
rowEnd = objSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
objSheet.Rows("1:" & rowEnd & "23").Copy
objNew.Range("A" & intRow & "C").Select
ActiveSheet.Paste
intRow = intRow + rowEnd
Next
End Sub

Answer 1

对那图进行的回答，
第一行已经是一个SUB的开始了，就没有必要再写一个Sub hebingbiao()

解决就是把Sub hebingbiao()行删除
两个End Sub只留一个就行了。

追问

请问是出现1004错误那个图吗？好像那个没有两个End Sub 啊？能说明详细点吗？最好是把正确的程序写出来，谢谢！！

追答

其实我倒更是想知道你的需求，
只是把多个SHEET合并到同一个SHEET中么？
每个SHEET有多少列？前几行是标题不是数据？

追问

你好，原题目是“
1、 将几个单月的销售表合并成一个表（合并2）（实例31\最终文件）
知识点：工作表的Add方法、单元格的Copy、Paste方法的使用，单元格区域末尾单元格的确认（课堂讲过的几种方法）
”有四个SHEET，每个SHEET有3列，23行，要求合并到新添加的表中，也就是合并成一个SHEET中，并命名为合并销售表
。

追答

Sub hebingbiao()
' Macro1 Macro
' 将多个工作表数据合并到新表中

Dim objSheet As Worksheet
Dim objNew As Worksheet
dim i as long
Dim intRow As Long
Dim rowEnd As Long

'这一小段是删除那个合并销售表
for each objsheet in sheets
if objsheet.name="合并销售表" then
application.DisplayAlerts=false
objsheet.delete
application.displayalerts=true
end if
next

'新建合并销售表到最后
Sheets.Add After:=Sheets(Sheets.Count)
Set objNew = Sheets(Sheets.Count)
objNew.Name = "合并销售表"

'新表粘贴行的位置
intRow = 1

'开始循环
For i = 1 To Sheets.Count - 1
Set objSheet = Sheets(i)
rowEnd = objSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'复制
objSheet.Rows("A1:C" & rowEnd).Copy
'选好位置，粘贴
objNew.Range("A" & intRow ).Select
ActiveSheet.Paste
'关闭复制粘贴MODE
Application.CutCopyMode=false
'新的行位置
intRow = intRow + rowEnd
Next
End Sub

这样你再试试。

Answer 2

就是没有结束语句呀

追问

你好，可以说详细点吗？因为我是帮人查的，不知道什么是结束语句啊，谢谢了。。。

追答

Sub hebingbiao()
' 将多个工作表数据合并到新表中
Dim objSheet As Worksheet
Dim objNew As Worksheet
Dim intRow As Long
Dim rowEnd As Long
Sheets.Add After:=Sheets(Sheets.Count)
Set objNew = Sheets(Sheets.Count)
ActiveSheet.Name = "合并销售表"
Set objSheet = ActiveSheet
intRow = 1
For i = 1 To Sheets.Count - 1
rowEnd = objSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
objSheet.Rows("1:" & rowEnd & "23").Copy
objNew.Range("A" & intRow & ":C" & intRow).Select
ActiveSheet.Paste
intRow = intRow + rowEnd
Next
End Sub
你的代码并不是提示end sub，而是提示1004
倒数第五行，你自己对照一下，单元格表示方法的错误

追问

这个是按你的那个程序改了之后的结果，请指教。

追答

你只要把

Dim objSheet As Worksheet
Dim objNew As Worksheet
Dim intRow As Long
Dim rowEnd As Long
Sheets.Add After:=Sheets(Sheets.Count)
Set objNew = Sheets(Sheets.Count)
ActiveSheet.Name = "合并销售表"
Set objSheet = ActiveSheet
intRow = 1
For i = 1 To Sheets.Count - 1
rowEnd = objSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
objSheet.Rows("1:" & rowEnd & "23").Copy
objNew.Range("A" & intRow & ":C" & intRow).Select
ActiveSheet.Paste
intRow = intRow + rowEnd
Next
加进去就行了，你有了两层sub了

你那个还提示错误，是因为你工作表已经有那个合并销售表了吧

追问

我把你上面的那个程序直接写进去，然后还是出现错误，错误如图。

追答

你还是把文件发过来吧sm100e@qq.com

追问

您好，请问有没有收到文件呢？这个是最终的效果图。

追答

我不知道你的是作业，没有按作业的要求处理，但方法一定比你的要求好，只是不适合作业要求了，呵呵

好的地方是使用了数组和字典，速度很快

用你的代码修改的，点2按钮即得