如何才能选择指定工作表合并，合并完然后提示完成

979595410

Sub CopyCellData()
Dim RowEnd
Dim SheetName
Dim SheetObj

SheetName = ActiveSheet.Name
RowEnd = ActiveSheet.UsedRange.Rows.Count

For Each SheetObj In Worksheets
    If SheetObj.Name <> SheetName Then

        RowEnd = SheetObj.UsedRange.Rows.Count
        SheetObj.Rows("1:" & RowEnd).Copy
        
        RowEnd = Sheets(SheetName).UsedRange.Rows.Count
        If RowEnd <> 1 Then
            Sheets(SheetName).Range("A" & RowEnd + 1) = SheetObj.Name
            Sheets(SheetName).Range("A" & RowEnd + 2).Select
        Else
            Sheets(SheetName).Range("A" & RowEnd) = SheetObj.Name
            Sheets(SheetName).Range("A" & RowEnd + 1).Select
        End If
        ActiveSheet.Paste
    End If
Next SheetObj


End Sub

zy3333351

学习，收藏 。

看见星光

按消息：
Sub 合并指定单元格()
    Dim sh As Worksheet, ar
    Application.ScreenUpdating = False
    [a2:g500].ClearContents
    With ActiveSheet
        For Each sh In ActiveWindow.SelectedSheets '判断sheet是否被选中
            If sh.Name <> .Name Then
                ar = sh.Range("A2:G" & sh.[a65536].End(3).Row)
                lr = .[a65536].End(3).Row + 1
                If lr < 7 Then lr = 7 '从最少第7行放置汇总数据
                .Range("A" & lr).Resize(UBound(ar), UBound(ar, 2)) = ar
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

979595410

看见星光 发表于 2018-4-19 09:57
按消息：
Sub 合并指定单元格()
    Dim sh As Worksheet, ar

多谢大神，谢谢