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部分;我从那里学到了很多我所知道的东西。

希望有所帮助

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

1 个答案: