Vba Excel如何在不覆盖数据的情况下将第一行复制并插入到所有其他工作表中

作为标题，我尝试了这一个，但它覆盖了现有的数据，我正在寻找一些 在向下移动数据的所有图纸中添加标题行。我有50张，这就是为什么我要问：-）

---

提前感谢

在填写页眉之前，您可以在每张表格中插入一行：

Sub CopyToAllSheets()

    Dim sheet As Worksheet
    For Each sheet In Sheets
        sheet.Rows("1:1").Insert Shift:=xlDown
    Next sheet

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("sheet1")
    Sheets.FillAcrossSheets ws.Range("1:1")

End Sub

---

我将假设你的标题将来自另一张纸。录制宏给了我：

Sub Macro4()
    Sheets("Sheet1").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
End Sub

清理它会带来：

Sub InsertOnTop()
    Sheets("Sheet1").Rows("1:1").Copy
    Sheets("Sheet2").Rows("1:1").Insert Shift:=xlDown
    Application.CutCopyMode = False
End Sub

在除源工作表以外的所有工作表上安全应用它：

Sub InsertOnTopOfEachSheet()
    Dim WS As Worksheet, Source As Worksheet
    Set Source = ThisWorkbook.Sheets("Sheet1") 'Modify to suit.
    Application.ScreenUpdating = False
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> Source.Name Then
            Source.Rows("1:1").Copy
            WS.Rows("1:1").Insert Shift:=xlDown
        End If
    Next WS
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Sub InsertOnTopOfEachSheet（）
将WS作为工作表，源作为工作表
将Source=ThisWorkbook.Sheets（“Sheet1”）修改为适合。
Application.ScreenUpdating=False
对于此工作簿中的每个WS。工作表
如果是WS.Name Source.Name，那么
Source.行（“1:1”）.复制
WS.行（“1:1”）。插入移位：=xlDown
如果结束
下一个WS
Application.CutCopyMode=False
Application.ScreenUpdating=True
端接头

---

让我们知道这是否有帮助。

我相信您需要在每张图纸上循环并插入一个空行，或者在每张图纸上使用range.insert方法。也许是这样的：

Option Explicit
Sub CopyToAllSheets()
  Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
    If Not WS.Name = "Sheet1" Then
        If WorksheetFunction.CountA(WS.Rows(1)) > 0 Then _
            WS.Rows(1).Insert
    End If
Next WS

Worksheets.FillAcrossSheets Worksheets("Sheet1").Rows(1), xlFillWithAll
End Sub

---

FillCrossSheets

是工作表对象的成员还是类模块？

Option Explicit
Sub CopyToAllSheets()
  Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
    If Not WS.Name = "Sheet1" Then
        If WorksheetFunction.CountA(WS.Rows(1)) > 0 Then _
            WS.Rows(1).Insert
    End If
Next WS

Worksheets.FillAcrossSheets Worksheets("Sheet1").Rows(1), xlFillWithAll
End Sub