Excel macro to merge multiple sheets: Difference between revisions
Jump to navigation
Jump to search
Created page with "通义千问 prompt: <pre> 合并 sheet1 sheet2 ... sheetN 的内容至 sheetNEW 请用宏处理 </pre> <syntaxhighlight lang="VBScript" line> Sub 合并多个工作表到SheetNEW() Dim ws As Worksheet Dim newWs As Worksheet Dim lastRow As Long Dim sourceWsName As String ' 创建新的工作表作为目标表 Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) newWs.Name = "SheetNEW" ' 开始..." |
No edit summary |
||
Line 31: | Line 31: | ||
End Sub | End Sub | ||
</syntaxhighlight> | </syntaxhighlight> | ||
[[Category:MicroSoft Office]] |
Latest revision as of 23:43, 6 December 2024
通义千问 prompt:
合并 sheet1 sheet2 ... sheetN 的内容至 sheetNEW 请用宏处理
Sub 合并多个工作表到SheetNEW()
Dim ws As Worksheet
Dim newWs As Worksheet
Dim lastRow As Long
Dim sourceWsName As String
' 创建新的工作表作为目标表
Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
newWs.Name = "SheetNEW"
' 开始合并过程
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "SheetNEW" Then ' 忽略已合并的目标工作表
lastRow = newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row + 1
' 复制每个工作表的内容到SheetNEW的下一个空行
ws.UsedRange.Copy Destination:=newWs.Range("A" & lastRow)
End If
Next ws
' 清理内存引用
Set ws = Nothing
Set newWs = Nothing
End Sub