[求助]总表列数据复制到指定表名的sheet1

半温

求助！
现有一张总表数据，想将表内数据分配到指定表名的各个工作簿的sheet1 内的D5:D139(这样我就很满足了已经)


若有大神进阶版的：
我的构思是按照总表数据 以Donnees和Sy巴拉巴拉忘记叫啥名的工作表 为模板（这两个工作表是连体婴儿。。。好像里面还有个隐藏的Calus的）的工作表 为一个独立工作簿,这样我就不用先建立指定表名的工作簿了（这个大家掠过就好，第一个我就很满足了）
感谢大家！

半温

虽然没有大神帮忙我也要每天顶一顶自己

两蛋一瓜

这个属于VBA知识，拆分表生成新的工作薄，如下（可查看宏代码，根据需求自行修改）：

半温

两蛋一瓜 发表于 2021-12-28 16:24
这个属于VBA知识，拆分表生成新的工作薄，如下（可查看宏代码，根据需求自行修改）：

太强了，大神！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！感谢!

半温

半温 发表于 2021-12-29 08:23
太强了，大神！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！！ ...

大神我还有问题，就是说我每个表中S巴拉巴拉的那个工作表是需要出图的，现在出不了图我是需要在代码哪部分做出怎样的改变

Sub 按字段拆分成独立工作薄()
    Application.ScreenUpdating = False
    Dim i, j
    Dim arr, brr
    Dim sht As Worksheet, mypath$, temp$
   
    '选择保存工作薄的文件路径
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择生成新工作薄的存储文件夹！"
        .AllowMultiSelect = False
        If .Show Then
            mypath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    If Right(mypath, 1) <> "\" Then mypath = mypath & "\"
   
    arr = Sheet1.Range("B5:L139")
    ReDim brr(1 To UBound(arr), 1 To 1)
    For j = 1 To UBound(arr, 2)
        For i = 1 To UBound(arr)
            brr(i, 1) = arr(i, j)
        Next
        temp = j & ".xlsm"
        ' 赋值，复制三份工作表生成新的工作薄，并保存到指定路径
        Sheets(Array("Donnees", "Synthesis", "Calculs")).Select
        Sheets(Array("Donnees", "Synthesis", "Calculs")).Copy
        Sheets("Calculs").Visible = False
        Range("D5:D139") = brr
        
        ActiveWorkbook.SaveCopyAs mypath & temp
        ActiveWorkbook.Close False
        ReDim brr(1 To UBound(arr), 1 To 1)
        k = 0
    Next

    Application.ScreenUpdating = True
End Sub

半温

但是有个新问题，Donnees 和Synthesis Calculs是连体婴儿，但是Synthesis里的图表，两张图出不来，有什么好的建议么

两蛋一瓜

半温 发表于 2021-12-29 09:20
但是有个新问题，Donnees 和Synthesis Calculs是连体婴儿，但是Synthesis里的图表，两张图出不来，有什么好 ...

如果只是“Synthesis”中图不显示问题，不需要更改宏代码（作用：三个sheet表新建工作薄，并在“Donnees”中填充数据，其它两个表中设置未动）我看了拆分后的表，图表显示正常，你检查下拆分表中“Calculs”是否有错误值

半温

两蛋一瓜 发表于 2021-12-29 11:41
如果只是“Synthesis”中图不显示问题，不需要更改宏代码（作用：三个sheet表新建工作薄，并在“Donnees ...

感谢您的回复，因为有看到出图的数据源是总表的数据源，相当与这11个工作表的图都是一样的，VBA可以固定住这两张图的数据源么=Calculs的东西，数据不要选择=[PPK总表数据]Calculs的东西，不过真心很感谢您的回复，让我感觉到，VBA很强大。

半温

感谢！上面的问题我解决了，我退而求其次将Calcus藏在了Synthes里面，现在整一个状态就是NICE !
工作表名称为我应该写在哪一列，就是工作表我不想要1 2 3 4 5 6 7 8 9 这个名称，我需要重命名这样的

两蛋一瓜

半温 发表于 2021-12-29 12:42
感谢！上面的问题我解决了，我退而求其次将Calcus藏在了Synthes里面，现在整一个状态就是NICE !
工作表名 ...

我用OFFICE运行的表没有这种异常，可以用代码重新定义....拆分后的工作薄名称可以在代码中更改命名规则（代码中temp的赋值规则）