循环并将 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")