Vba 在多个单元格上运行单个宏

我写了一个宏，它插入几行，然后将存在于一个单元格中的文本转换为一列，由分隔符将文本分隔开，然后将其转置，并将其复制为先插入的行。我只能在一个单元格上运行宏以获得结果。但现在我想在其他50个单元格上运行宏。我该怎么做

我的代码在下面

Sub Newsroom()
'
' Macro
' By Ganesh
'
' Keyboard Shortcut: Ctrl+Shift+G
'
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=True, Comma:=True, Space:=True, Other:=True, FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
        , 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
        (14, 1)), TrailingMinusNumbers:=True
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    ActiveCell.Offset(-1, 3).Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveCell.Offset(-1, 1).Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveCell.Offset(21, -1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "ALLNEWSPLUS"
    With ActiveCell.Characters(Start:=1, Length:=11).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16777216
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    ActiveCell.Offset(-21, -2).Range("A1:B1").Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:B22"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:B22").Select
End Sub

---

在不重新编写所有代码的情况下（您应该摆脱

Selection

和

ActiveCell

引用，以支持更面向对象的编程），您需要实现一个循环

假设您最初选择要操作的单元格范围（1列）：

Sub foo()
    Dim rng as Range
    Dim r as Long
    Set rng = Range(Selection.Address)

    For r = rng.Cells.Count to 1 Step -1
        rng.Cells(r).Select

        '''''''''''''''''''''''''''''''''''
        '''''''''''''''''''''''''''''''''''
        ' ALL OF YOUR CODE BELONGS HERE
        '
        '
        '
        '''''''''''''''''''''''''''''''''''
        '''''''''''''''''''''''''''''''''''

    Next
End Sub

---

您好，David，谢谢您的输入，但由于我是VBA新手，我感到困惑，您能告诉我在哪里替换以前代码中的上述代码吗。@user2800680这个示例有什么不清楚的地方吗？我提供的代码应该包含您的所有代码。在我修改过的占位符中（上面写着“您的所有代码都属于这里”）是您应该放置所有现有代码的地方。您好David，非常感谢您的快速响应。。。谢谢你。。我得到了预期的结果。