Question

我的工作簿包含多个工作表，每个工作表行8包含列标题。每张纸与其他纸张的列相同，但列数因工作而异。我需要编写一个宏，以便当一个新的列标题被添加到一个表的末尾时，它会将它添加到所有其他表（有一些例外，可以在我的代码中看到）。列名由输入框控制，但由于列数可能不同，我在尝试使用此值时无法修复单元格范围。

这是我目前的代码。我没有运气试图添加额外的列名称，所以我尝试复制第8行中的所有列名称但是还没有能够让它工作。我对VBA很新，任何帮助都将不胜感激！

Sub AddNewColumns()

Dim NewColumn As String
Dim rng As Range

NewColumn = InputBox("Please enter a name for the new column")

    Range("A8").Select
    ActiveCell.End(xlToRight).Select
    ActiveCell.Offset(0, 1).Select

    ActiveCell.Value = NewColumn

    Range("A8").Select
    Range(Selection, Selection.End(xlToRight)).Select

    Set rng = Selection

    Selection.Copy

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets

    If ws.Name <> "SheetList" And ws.Name <> "Blank Sheet" And ws.Name <> "Dashboard" And ws.Name <> "Combined" And ws.Name <> "MasterCheck" Then

    ws.Range("A8").Value = rng.Value

    End If

    Next ws

End Sub

由于

Answer 1

给它一个机会。应该足够简单，以便自己理解：

Option Explicit

Sub AddNewColumns()

    Dim newColumn As String
    newColumn = InputBox("Please enter a name for the new column")

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "SheetList" And ws.Name <> "Blank Sheet" And ws.Name <> "Dashboard" And ws.Name <> "Combined" And ws.Name <> "MasterCheck" Then

            ws.Range("A8").End(xlToRight).Offset(,1).Value = newColumn

        End If

    Next

End Sub

Answer 2

如果将if语句更改为this，它将起作用：

If ws.Name <> "SheetList" And ws.Name <> "Blank Sheet" And ws.Name <> 
"Dashboard" And ws.Name <> "Combined" And ws.Name <> "MasterCheck" Then

        ws.Range(rng.Address).Value = rng.Value

    End If

以及一些稍微修改过的代码供您查看：

    Sub AddNewColumns()
    Dim strHeadingToInsert As String
    Dim wks As Worksheet

        strHeadingToInsert = InputBox("Please enter a name for the new column")


        For Each wks In ThisWorkbook.Worksheets

            If wks.Name <> "SheetList" And wks.Name <> "Blank Sheet" And wks.Name <> "Dashboard" And wks.Name <> "Combined" And wks.Name <> "MasterCheck" Then

                wks.Range("A8").End(xlToRight).Offset(0, 1) = strHeadingToInsert

            End If

        Next wks

    End Sub

Answer 3

感谢所有给出的答案，它们都很有效，我可以保留以供将来使用的一些选项：）

我选择了第一个选项，但所有答案都完成了工作

Option Explicit

Sub AddNewColumns()

Dim newColumn As String
newColumn = InputBox("Please enter a name for the new column")

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets

    If ws.Name <> "SheetList" And ws.Name <> "Blank Sheet" And ws.Name <> "Dashboard" And ws.Name <> "Combined" And ws.Name <> "MasterCheck" Then

        ws.Range("A8").End(xlToRight).Offset(,1).Value = newColumn

    End If

Next

End Sub

使用输入框将单元格值添加到多个工作表中

3 个答案: