如何把一个表中的内容复制到新建的表中

huohuanshu

各位大神，我现在有两张工作表，要把其中一个表“信息”里的内容按行复制到以“小报单”为格式建的新表里面，新表以第一列的内容命名，不同的数据建立不同的表格并填充内容，但是如果第一列有重复的内容，则不建立新表，而是把重复的这行其中几个单元内容填充到已经建立的表格里，例如第三行和第六行的第一列内容重复，这两行合并到一个表，但是要把“小报单”这个表里的如下图内容顺次填充下去，如何实现？真心求教

发货单号

货物属性

箱数

件数

这是现在用的代码，会提示重命名报错，而且实现不了合并数据的功能。
Option Explicit
Sub test()
    Dim i&, j%, sht, arr
    arr = Sheets("信息").[a1].CurrentRegion
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each sht In Sheets
        If sht.Name <> "信息" And sht.Name <> "小报单" Then
            sht.Delete
        End If
    Next
    For i = 3 To UBound(arr)
        Sheets("小报单").Copy After:=Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
            .Name = arr(i, 1)
            .Range("B3") = arr(i, 4)
            .Range("B4") = arr(i, 6)
            .Range("B5") = arr(i, 9)
            .Range("B6") = arr(i, 19)
            .Range("B7") = arr(i, 18)
            .Range("A9") = arr(i, 3)
            .Range("E3") = arr(i, 15)
            .Range("E4") = arr(i, 16)
            .Range("E5") = arr(i, 7)
            .Range("E6") = arr(i, 20)
            .Range("D9") = arr(i, 11)
            .Range("E9") = arr(i, 12)
            .Range("C9") = arr(i, 2)
        End With
        Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

高

加了字典，判断工作表是否已经存在。

huohuanshu

高 发表于 2019-8-13 16:58
加了字典，判断工作表是否已经存在。

可以了，感谢大神帮助。

shiwenzan

学习借鉴一下，标记回复+感谢！