VBA Excel-复制和粘贴列宽/分组

我试图将整个工作表从“DNU”复制到每个工作表中。我希望做一个定期粘贴，以保持宽度和分组，但这将只粘贴公式和表格格式。多谢各位

代码如下：

~

---

您不需要使用

复制/粘贴

<代码>值可以有

参数

，

11

传输值和格式

Dim i As Integer
With ThisWorkbook
    For i = 2 To .Worksheets.Count
        .Worksheets(i).Range("A1:Y200").Value(11) = .Worksheets("Sheet1").Range("A1:Y200").Value(11)
        'Unsure how you accomplish your grouping,
        .Worksheets(i).Range("A1:Y200").OutlineLevel = .Worksheets("Sheet1").Range("A1:Y200").OutlineLevel

        Dim colx As Long
        For colx = 1 To 25
            Worksheets(i).Columns(colx).ColumnWidth = Worksheets("Sheet1").Columns(colx).ColumnWidth
            Worksheets(i).Columns(colx).OutlineLevel = Worksheets("Sheet1").Columns(colx).OutlineLevel
        Next

        Dim rowx As Long
        For rowx = 1 To 200
            Worksheets(i).Rows(rowx).OutlineLevel = Worksheets("Sheet1").Rows(rowx).OutlineLevel
        Next

    Next
End With

---

根据工作表的不同，复制工作表和清除不需要的内容可能更容易。这将保留所有格式谢谢！格式保持不变，但由于某种原因，分组消失了。是否有办法将“DNU”工作表中的分组包括在内？还是必须为每个工作表自动执行此操作？@Hiimtroymcclure；我更新了答案以复制您的分组。我不使用组，所以可能不起作用。请复印一份。如果不起作用，您可能必须使用vba重新应用组。感谢GMalc，我遇到了一个运行时错误：无法获取Range类的OutlineLevel属性。就像你提到的，我可能需要重新申请分组。

Dim i As Integer
With ThisWorkbook
    For i = 2 To .Worksheets.Count
        .Worksheets(i).Range("A1:Y200").Value(11) = .Worksheets("Sheet1").Range("A1:Y200").Value(11)
        'Unsure how you accomplish your grouping,
        .Worksheets(i).Range("A1:Y200").OutlineLevel = .Worksheets("Sheet1").Range("A1:Y200").OutlineLevel

        Dim colx As Long
        For colx = 1 To 25
            Worksheets(i).Columns(colx).ColumnWidth = Worksheets("Sheet1").Columns(colx).ColumnWidth
            Worksheets(i).Columns(colx).OutlineLevel = Worksheets("Sheet1").Columns(colx).OutlineLevel
        Next

        Dim rowx As Long
        For rowx = 1 To 200
            Worksheets(i).Rows(rowx).OutlineLevel = Worksheets("Sheet1").Rows(rowx).OutlineLevel
        Next

    Next
End With