循环并将 Copy/Paste 等于变量的所有行放入新的 Excel 文件中
Loop and Copy/Paste all Rows equaling a variable into a new Excel File
我是 vba 的新手,非常感谢您的帮助。
经过长时间的无果搜索,我找不到我的代码无法运行的原因。
为了解释这个问题,我有一个 Excel 文件,其中包含一堆数据,这些数据按 A 列中名为 Prod.Type 的索引排序。
这是我正在尝试做的一个例子:
代码应该:
在循环中检查 Prod.Type 的所有行值和
如果选中的行等于变量 prodNum,则它将行复制到新的 excel 文件中。
否则它会关闭文件并递增 prodNum 并再次循环直到检查了整个列,当然它会为每个 produNum 创建一个新的 Excel 文件,这被证明是正确的。
prodNum = 2 的结果应该只显示 header 和等于 2
的行
但我得到的结果只是 headers 行被粘贴
这是我编写的代码
Sub test()
Dim wbtarget As Excel.Workbook
Dim consh As Worksheet
Dim prodNum As Long
Dim i As Long
Dim shnum As Long
Set consh = ThisWorkbook.Sheets("Sheet1")
For counter = 1 To 20
Set wbtarget = Workbooks.Add
consh.Rows(1).Copy wbtarget.Sheets(1).Range("A1")
For i = 1 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = prodNum Then
consh.Rows("A" & i).Copy wbtarget.Sheets(1).Range("A2")
Else
wbtarget.SaveAs "C:\Users\Anon\Desktop\Project\" & shnum & ".xlsx" 'path to save file
prodNum = prodNum + 1
shnum = shnum + 1
End If
Next
Next counter
End Sub
"For counter = 1 To 20"是为了测试,我有6000多行数据要复制粘贴。
在此先感谢您的帮助!
你的错误在这里:
consh.Rows("A" & i).Copy wbtarget.Sheets(1).Range("A2")
应该不是rows
,而是Range
:
consh.Range("A" & i).Copy wbtarget.Sheets(1).Range("A2")
或没有 A
:
consh.Rows(i).Copy wbtarget.Sheets(1).Range("A2")
我是 vba 的新手,非常感谢您的帮助。 经过长时间的无果搜索,我找不到我的代码无法运行的原因。
为了解释这个问题,我有一个 Excel 文件,其中包含一堆数据,这些数据按 A 列中名为 Prod.Type 的索引排序。
这是我正在尝试做的一个例子:
代码应该:
在循环中检查 Prod.Type 的所有行值和 如果选中的行等于变量 prodNum,则它将行复制到新的 excel 文件中。
否则它会关闭文件并递增 prodNum 并再次循环直到检查了整个列,当然它会为每个 produNum 创建一个新的 Excel 文件,这被证明是正确的。
prodNum = 2 的结果应该只显示 header 和等于 2
的行但我得到的结果只是 headers 行被粘贴
这是我编写的代码
Sub test()
Dim wbtarget As Excel.Workbook
Dim consh As Worksheet
Dim prodNum As Long
Dim i As Long
Dim shnum As Long
Set consh = ThisWorkbook.Sheets("Sheet1")
For counter = 1 To 20
Set wbtarget = Workbooks.Add
consh.Rows(1).Copy wbtarget.Sheets(1).Range("A1")
For i = 1 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = prodNum Then
consh.Rows("A" & i).Copy wbtarget.Sheets(1).Range("A2")
Else
wbtarget.SaveAs "C:\Users\Anon\Desktop\Project\" & shnum & ".xlsx" 'path to save file
prodNum = prodNum + 1
shnum = shnum + 1
End If
Next
Next counter
End Sub
"For counter = 1 To 20"是为了测试,我有6000多行数据要复制粘贴。
在此先感谢您的帮助!
你的错误在这里:
consh.Rows("A" & i).Copy wbtarget.Sheets(1).Range("A2")
应该不是rows
,而是Range
:
consh.Range("A" & i).Copy wbtarget.Sheets(1).Range("A2")
或没有 A
:
consh.Rows(i).Copy wbtarget.Sheets(1).Range("A2")