Excel VBA问题：While循环无法完成遍历执行

问题描述 #

我编写了一段VBA代码用于将数据粘贴至Excel某列，接下来尝试遍历该列（B列）中的所有值，为B列的每个值创建对应的新工作表，但程序仅完成一次创建操作后便停止，并未继续遍历B列剩余值。代码如下：

i = 4
Do While Cells(i, 2).Value <> ""
    Worksheets("Front").Cells(5, 3).Value = Cells(i, 2)
    Worksheets("Front").Select
    Range("C2:M35").Select
    Selection.Copy
    Sheets("PlaceHolder").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Dim wks As Worksheet
    Set wks = ActiveSheet
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    ActiveSheet.Name = wks.Range("C5").Value
    i = i + 1
Loop

核心问题分析 #

这段代码只执行一次就停止，最关键的原因是未限定工作表的单元格引用，加上频繁使用Select/Activate导致上下文混乱：

• 第一次循环执行到ActiveSheet.Copy后，新复制的工作表会成为当前激活的工作表。
• 下一次循环判断Cells(i, 2).Value <> ""时，Cells(i,2)默认指向当前激活的新工作表，而不是你原本存放B列数据的那个工作表——新工作表的B列第5行（此时i已经变成5）是空值，所以循环直接终止。
• 频繁的Select操作不仅效率低，还很容易让代码的操作对象偏离预期，是VBA开发里的常见“坑”。

修复后的代码 #

我给你调整了代码，去掉了所有不必要的Select，并且明确限定了每个操作的工作表对象，确保循环始终引用正确的数据源：

Sub CreateSheetsFromColumn()
    Dim dataSheet As Worksheet
    Dim frontSheet As Worksheet
    Dim placeholderSheet As Worksheet
    Dim newSheet As Worksheet
    Dim i As Integer
    
    ' 替换成你存放B列数据的工作表名称
    Set dataSheet = ThisWorkbook.Worksheets("你的数据源工作表名")
    Set frontSheet = ThisWorkbook.Worksheets("Front")
    Set placeholderSheet = ThisWorkbook.Worksheets("PlaceHolder")
    
    i = 4
    ' 始终限定引用dataSheet的B列，避免上下文切换出错
    Do While dataSheet.Cells(i, 2).Value <> ""
        ' 给Front表的C5赋值
        frontSheet.Cells(5, 3).Value = dataSheet.Cells(i, 2).Value
        
        ' 直接复制Front表的指定区域，无需Select
        frontSheet.Range("C2:M35").Copy
        
        ' 粘贴到Placeholder表，无需Select
        With placeholderSheet.Range("C2")
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        
        ' 复制Placeholder表并命名
        placeholderSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        newSheet.Name = frontSheet.Cells(5, 3).Value
        
        i = i + 1
    Loop
    
    ' 清除剪贴板，避免弹窗提示
    Application.CutCopyMode = False
End Sub

关键优化点 #

• 明确指定工作表对象：所有单元格/区域操作都绑定到具体的工作表变量，再也不会因为激活其他表而引用错误。
• 移除所有Select/Selection：直接操作对象的方式更高效，也更稳定。
• 添加剪贴板清除：避免执行完代码后弹出剪贴板内容的提示框。

内容的提问来源于stack exchange，提问作者DarylR