练习-合并拆分后的表格

练习-合并拆分后的表格_第1张图片

将拆分得到的各表重新复制到表1(数据)

Sub t()

Dim i, j As Integer
Dim sht As Worksheet

'清空数据表中的数据'
Sheet1.Range("a1:f65536").ClearContents

'复制表2的表头到表一'
Sheet2.Range("a1:f1").Copy Sheet1.Range("a1")

'复制数据'
For Each sht In Sheets
    If sht.Name <> "数据" Then
        '判断表2之后的表共有几行'
        i = sht.Range("a65536").End(xlUp).Row
        '判断粘贴到表1后内容的行数'
        j = Sheet1.Range("a65536").End(xlUp).Row
        
        sht.Range("a2:f" & i).Copy Sheet1.Range("a" & j + 1)
    End If
Next
End Sub

进阶 -- 弹出提示框询问用户有表头有几行

Sub t2()
Dim i, j, k As Integer
Dim sht As Worksheet

k = InputBox("请问表头一共有多少行")

'清空数据表'
Sheet1.Range("a1:f65536").ClearContents

'复制表头'
Sheet2.Range("a1:f" & k).Copy Sheet1.Range("a1")

'复制内容'
For Each sht In Sheets
    If sht.Name <> 数据 Then
        '判断需复制的表一共有多少行'
        i = sht.Range("a65536").End(xlUp).Row
        
        '表1中的行数'
        j = Sheet1.Range("a65536").End(xlUp).Row
        
        sht.Range("a" & k + 1 & ":f" & i).Copy Sheet1.Range("a" & k + 1 & ":f" & j + 1)
        
    End If
Next
MsgBox "处理完毕"
End Sub

你可能感兴趣的:(练习-合并拆分后的表格)