Excel macro to merge multiple sheets

From 清冽之泉
Revision as of 16:34, 20 November 2024 by Mwroot (talk | contribs) (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" ' 开始...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search

通义千问 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