vba Excel如何在不覆盖数据的情况下将第一行复制并插入到所有其他工作表中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20680015/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel how to Copy and insert the first row into all other sheets without overwriting data
提问by sviluppocsharp
As the title I tried this one, but it overwrites existing data, I am looking for something that add the header row in all sheets moving the data down. I have got 50 sheets that's why I am asking :-)
作为标题，我尝试了这个，但它覆盖了现有数据，我正在寻找可以在所有工作表中添加标题行并向下移动数据的内容。我有 50 张纸，这就是我问的原因:-)
Sub CopyToAllSheets()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("sheet1")
Sheets.FillAcrossSheets ws.Range("1:1")
End Sub
Thank you in advance
先感谢您
回答by brWHigino
You could insert a line in each sheet before filling the headers:
您可以在填充标题之前在每个工作表中插入一行：
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
回答by Jerome Montino
I will be assuming that your header will be coming from another sheet. Recording a macro gives me:
我将假设您的标题将来自另一张纸。录制宏给了我：
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
Cleaning it up gives:
清理它给出：
Sub InsertOnTop()
Sheets("Sheet1").Rows("1:1").Copy
Sheets("Sheet2").Rows("1:1").Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub
Applying it safely across all sheets except the source sheet:
将其安全地应用于除源工作表之外的所有工作表：
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
Let us know if this helps.
如果这有帮助，请告诉我们。
回答by Ron Rosenfeld
I believe you will need to loop through each sheet and insert a blank row, or just use the range.insert method on each sheet. Perhaps something like:
我相信您需要遍历每张纸并插入一个空白行，或者只在每张纸上使用 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
