VBA LOOP 在所有工作表上创建相同的标题？

Question

我想在所有工作表的第 1 行放置相同的内容。我将如何创建一个循环来做到这一点？我对 VBA 很陌生。我录制了一个宏，但它仍然很长。 18 个工作表需要有这个。这是录制的宏的样子。

Sheets("C3 MBEL TET OPIS_CMA").Select
Range("F1").Select
ActiveCell.FormulaR1C1 = "PSTRIK"
Range("A1").Select
ActiveCell.FormulaR1C1 = "PRECID"
Range("C1").Select
ActiveCell.FormulaR1C1 = "PEXCH"
Range("J1").Select
ActiveCell.FormulaR1C1 = "PQTY"
Range("G1").Select
ActiveCell.FormulaR1C1 = "PCTYM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "PFC"
Range("B1").Select
ActiveCell.FormulaR1C1 = "PACCT"
Range("K1").Select
ActiveCell.FormulaR1C1 = "PPRTCP"
Range("E1").Select
ActiveCell.FormulaR1C1 = "PSUBTY"
Range("H1").Select
ActiveCell.FormulaR1C1 = "PSBUS"
Range("I1").Select
ActiveCell.FormulaR1C1 = "PBS"

当然，除了使用不同的工作表名称之外，这还要重复 17 次。

Answer 1

您可以使用一个数组来存储要写入标题的工作表名称，然后遍历该数组来写入它。

Option Explicit

Public Sub WriteHeaderIntoSheets()
    Dim WorksheetNames As Variant
    WorksheetNames = Array("C3 MBEL TET OPIS_CMA", "Sheet1", "Sheet2", "Sheet3") 'your sheet names

    Dim ws As Variant
    For Each ws In WorksheetNames 
        With Worksheets(ws)
            .Range("F1").FormulaR1C1 = "PSTRIK"
            .Range("A1").FormulaR1C1 = "PRECID"
            .Range("C1").FormulaR1C1 = "PEXCH"
            .Range("J1").FormulaR1C1 = "PQTY"
            .Range("G1").FormulaR1C1 = "PCTYM"
            .Range("D1").FormulaR1C1 = "PFC"
            .Range("B1").FormulaR1C1 = "PACCT"
            .Range("K1").FormulaR1C1 = "PPRTCP"
            .Range("E1").FormulaR1C1 = "PSUBTY"
            .Range("H1").FormulaR1C1 = "PSBUS"
            .Range("I1").FormulaR1C1 = "PBS"
        End With
    Next ws
End Sub

---

或者，您也可以在标题行中使用数组，这样会更快。

Option Explicit

Public Sub WriteHeaderIntoSheets()
    Dim WorksheetNames As Variant
    WorksheetNames = Array("C3 MBEL TET OPIS_CMA", "Sheet1", "Sheet2", "Sheet3") 'your sheet names

    Dim HeaderRow As Variant 'your header values
    HeaderRow = Array("PRECID", "PACCT", "PEXCH", "PFC", "PSUBTY", "PSTRIK", "PCTYM", "PSBUS", "PBS", "PQTY", "PPRTCP")

    Dim ws As Variant
    For Each ws In WorksheetNames
        Worksheets(ws).Range("A1").Resize(ColumnSize:=1 + UBound(HeaderRow)).Value = HeaderRow
    Next ws
End Sub