如何用VBA将Sheet1指定表头行复制到多个新建工作表？

原代码中粘贴表头的写法错误，wsTo.Paste = header1并非正确的VBA语法。正确做法是直接对表头Range对象使用Copy方法，指定目标工作表的对应行作为粘贴位置。

核心修改点 #

• 替换错误的粘贴语句，改用Copy方法直接复制表头到目标行
• 确保表头粘贴到新工作表的第1行和第3行，保留原结构
• 调整新工作表的数据起始行，避免覆盖表头

修改后的完整代码 #

Sub SplitIntoSheets()

' Steps to prep sheet:
'    Ensure there are exactly 3 header rows (code will ignore first three rows)
'    sort data by Provider (must filter out blank lines)
'    Replace all 'Dr. ' with '' in column C (sheet names cannot have punctuation)

Dim MyCell As Range, MyRange As Range, header1 As Range, header2 As Range
Dim wsFrom As Worksheet, wsTo As Worksheet
Dim lastrow As Long

Set wsFrom = ActiveSheet
Set MyRange = wsFrom.Range("C3:C2000")

Set header1 = wsFrom.Rows(1)
Set header2 = wsFrom.Rows(3)

' 清理C列的Dr.前缀
For Each MyCell In MyRange
    If Len(MyCell) > 0 Then
        MyCell.Value = shrinkNames(MyCell.Value)
    End If
Next MyCell

' 按C列值拆分数据到对应工作表
For Each MyCell In MyRange
    If Len(MyCell) > 0 Then
        If Not sheetExist(MyCell.Value) Then
            Set wsTo = Worksheets.Add(After:=Worksheets(Worksheets.Count)) '创建新工作表
            wsTo.Name = MyCell.Value '重命名新工作表
            
            ' 复制第1行表头到新表第1行
            header1.Copy Destination:=wsTo.Rows(1)
            ' 复制第3行表头到新表第3行
            header2.Copy Destination:=wsTo.Rows(3)
            
            lastrow = 4 ' 数据从第4行开始粘贴（避开表头行）
        Else
            Set wsTo = Worksheets(MyCell.Value)
            lastrow = wsTo.Cells(wsTo.Rows.Count, 1).End(xlUp).Row + 1
        End If
        
        ' 复制原数据行到目标工作表
        wsFrom.Rows(MyCell.Row).Copy wsTo.Range("A" & lastrow)
    End If
Next MyCell

End Sub

Function sheetExist(sSheet As String) As Boolean
    On Error Resume Next
    sheetExist = (ActiveWorkbook.Sheets(sSheet).Index > 0)
End Function

Function shrinkNames(sName As String) As String
    shrinkNames = Replace(sName, "Dr. ", "")
End Function

关键说明 #

1. 表头复制逻辑：通过header1.Copy Destination:=wsTo.Rows(1)直接将原表第1行完整复制到新表第1行，包括格式和内容，第3行表头同理处理。
2. 数据起始行调整：新工作表创建后，数据从第4行开始粘贴，避免覆盖已复制的表头。
3. 变量修正：补充了原代码中漏声明的MyRange变量，移除了未使用的fromRange变量。

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