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

作为标题，我尝试了这一个，但它覆盖现有的数据，我正在寻找的东西，添加标题行在所有表中移动数据。 我有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

我会假设你的标题将来自另一张表。 录制一个macros给我：

 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