如何自动将分表录入的信息自动提取到总表

han410725314

各位大神、老师好  ，因工作需要想将分表的信息汇总到总表 ，复制粘贴的方法太耗时了  。麻烦了 用什么方法可做

han410725314

爱疯

'入口
Sub Join_Worksheet()
    Dim wb1, wb2, i, j, r

    Application.ScreenUpdating = False
    If Application.FindFile = False Then End
    Set wb1 = ActiveWorkbook    '源
    Set wb2 = Workbooks.Add     '目
    For i = 1 To wb1.Sheets.Count
        r = IIf(i = 1, 1, wb2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1)
        wb1.Sheets(i).Range("a1").CurrentRegion.Offset(IIf(i = 1, 0, 1), 0).Copy wb2.Sheets(1).Cells(r, 1)
    Next i

    wb1.Close 0
    Call Over("自定义总表名称")
End Sub

'结束
Sub Over(txt)
    Call DelBlankSheet
    ActiveWorkbook.SaveAs ThisWorkbook.path & "\" & txt & "_" & Format(Now, "yyyymmdd_hhmmss")
    ActiveWorkbook.Close
End Sub

'删除空白表
Sub DelBlankSheet()
    Dim x
    Application.DisplayAlerts = False
    For Each x In Sheets
        If IsEmpty(x.UsedRange) And x.Shapes.Count = 0 And Sheets.Count > 1 Then
            x.Delete
        End If
    Next x
End Sub

不知道有没有问题

han410725314

爱疯 发表于 2019-1-27 09:45
'入口
Sub Join_Worksheet()
    Dim wb1, wb2, i, j, r

这个是用什么上啊  

爱疯

han410725314 发表于 2019-1-27 22:37
这个是用什么上啊

等你传了附件才好说

han410725314

爱疯 发表于 2019-1-28 07:43
等你传了附件才好说

附件传不上

爱疯

han410725314 发表于 2019-1-31 10:34
附件传不上

传不了时提示什么？
附件压缩了吗？
附件过大吗？

han410725314

这个

han410725314

爱疯 发表于 2019-1-31 10:37
传不了时提示什么？
附件压缩了吗？
附件过大吗？

上传了    ，就是把分表的数据自动汇总到总表

爱疯

Sub 按钮1_Click()
    Dim i, r1, r2
    Application.ScreenUpdating = False
    Sheets(1).Select
    Range("a:j").Clear

    For i = 2 To Sheets.Count
        r1 = Cells(Rows.Count, 2).End(xlUp).Row + 1
        r2 = Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row + 1
        Sheets(i).Range("a1:j" & r2).Offset(IIf(i = 2, 0, 1), 0).Copy Cells(IIf(i = 2, 1, r1), 1)
    Next i

    r1 = Cells(Rows.Count, 2).End(xlUp).Row + 1
    Range(Cells(r1, 1), Cells(65536, "j")).Clear
    With Range("a1").CurrentRegion
        .EntireColumn.AutoFit
        .ClearFormats
    End With
End Sub
2019换货记录b.rar (32.9 KB, 下载次数: 73)

2019-1-31 15:51 上传

点击文件名下载附件