Excel-将每一行复制到新工作簿中，但保留列名-宏

Question

我发现了这个很棒的宏，它可以将数据框中的每一行分别复制到一个新的工作表中，但也保留第一行的列名：

 Sub abc_01()
 Dim WS As Worksheet, newWS As Worksheet
 Dim X As String
 Application.ScreenUpdating = False
 Set WS = Sheets("Sheet1")
 On Error Resume Next
 X = InputBox("number of names 1,2,", , "9")
 For i = 1 To X
 Set newWS = Worksheets.Add(after:=Worksheets(Worksheets.Count))
 WS.Range("A1:G1").Copy Destination:=newWS.Range("A1")
 WS.Range(WS.Cells(i + 1, "A"), WS.Cells(i + 1, "G")).Copy
 newWS.Range("A2").PasteSpecial xlValues
 Next i
 On Error GoTo 0
 Application.ScreenUpdating = True
 End Sub

我现在尝试将其复制到新的工作簿中，而不是新的工作表中，但是当我运行它时，新的工作簿仍为空。 另外，我还没有将新工作簿另存为新文件名（如果可能，最好是一个特定的单元格值？）

 Sub abc_02()
 Dim thisWB  As String
 Dim newWB As String
 thisWB = ActiveWorkbook.Name
 Dim X As String
 Application.ScreenUpdating = False
 Set WS = Sheets("Sheet1")
 On Error Resume Next
 X = InputBox("number of names 1,2,", , "9")
 For i = 1 To X
 Workbooks.Add
 ActiveWorkbook.SaveAs supName
 newWB = ActiveWorkbook.Name
 Windows(thisWB).Activate
 Sheets("Sheet1").Select
 Range("A1:G1").Copy
 Windows(newWB).Activate
 Sheets("Sheet1").Select
 ActiveSheet.Range("A1").Select
 ActiveSheet.Range("A1").Paste
 Windows(thisWB).Activate
 Sheets("Sheet1").Select
 Range(Sheet1.Cells(i + 1, "A"), Sheet1.Cells(i + 1, "G")).Copy
 Windows(newWB).Activate
 Sheets("Sheet1").Select
 Range("A2").PasteSpecial xlValues
 Next i
 On Error GoTo 0
 Application.ScreenUpdating = True
 End Sub

我是VBA新手，所以对您的帮助非常感谢！

Answer 1

在原始代码中，

Dim WS As Worksheet, newWS As Worksheet
Dim X As String

Dim WS作为工作表，而newWS作为工作表告诉Excel“ WS和newWS将是工作表。” 在代码的后面，分别将它们设置为WS，将其设置为活动工作簿中的Sheet1，将newWS设置为活动工作簿中的新工作表。

更改

Dim thisWB  As String
Dim newWB As String

至

Dim thisWB  As Workbook
Dim newWB As Workbook

应该解决您的问题。
您应该将此thisWB和newWB调为工作簿，而不是字符串。
Excel将寻找文本字符串而不是工作簿。

另外-尝试查看ExcelForum.com VBA部分； 我从那里中学到了很多东西。

希望能有所帮助