Question

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

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

提前谢谢

Answer 1

您可以在填充标题之前在每张表格中插入一行：

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

Answer 2

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

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

如果有帮助，请告诉我们。

Answer 3

我相信您需要遍历每个工作表并插入一个空行，或者只需在每个工作表上使用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

Excel如何复制并将第一行插入所有其他工作表而不覆盖数据

3 个答案: