用VBA数组把三个工作表内容合并到总表 有两种合并

用VBA数组把三个工作表内容合并到总表 有两种合并

Sub s()
    Dim sh As Worksheet
    With Sheets("总表")
        For Each sh In Sheets
            If sh.Name <> "总表" Then
                n = sh.Cells(Rows.Count, 1).End(3).Row
                m = sh.Cells(n, 1).End(3).Row + 1
                sh.Range(sh.Cells(m, 1), sh.Cells(n, 5)).Copy .Cells(Rows.Count, 1).End(3).Offset(1)
            End If
        Next
        n = .Cells(Rows.Count, 1).End(3).Row '本行开始排序
        m = .Cells(n, 1).End(3).Row + 1
        arr = .Range(.Cells(m, 1), .Cells(n, 5))
        Do While k < 4 ^ 10
            k = 4 ^ 10
            For i = 1 To UBound(arr)
                If arr(i, 1) < k Then
                    k = arr(i, 1)
                    r = i
                End If
            Next
            If k < 4 ^ 10 Then
                For i = 1 To 5
                    .Cells(m, i) = arr(r, i)
                Next
                m = m + 1
                arr(r, 1) = 4 ^ 10
            End If
        Loop '本行结束排序,删除排序代码即不排序
    End With
End Sub来自:求助得到的回答
温馨提示:答案为网友推荐,仅供参考
第1个回答  2017-04-16
参考代码:
Sub Combine()

Dim J As Integer

On Error Resume Next

Sheets(1).Select

Worksheets.Add

Sheets(1).Name = "Combined"

Sheets(2).Activate

Range("A1").EntireRow.Select

Selection.Copy Destination:=Sheets(1).Range("A1")

For J = 2 To Sheets.Count

Sheets(J).Activate

Range("A1").Select

Selection.CurrentRegion.Select

Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)

Next

End Sub本回答被网友采纳
相似回答