美文网首页
练习-合并拆分后的表格

练习-合并拆分后的表格

作者: A_rrow | 来源:发表于2019-07-17 22:55 被阅读0次

    将拆分得到的各表重新复制到表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
    

    相关文章

      网友评论

          本文标题:练习-合并拆分后的表格

          本文链接:https://www.haomeiwen.com/subject/vjdhlctx.html