excel - 如何在 Excel 中使用 VBA 将某些行复制到不同工作表上的不同范围？

Question

我正在尝试做的一般想法是从一张满足特定条件的工作表中复制某些行（我将在下一句中解释），然后将这些行粘贴到新创建的工作表中的不同范围内相同的工作簿。抓取某一行的标准是该行的第一个单元格中的值是否在用户指定的范围内。例如，如果用户输入“4”作为下限，“8”作为上限，我的代码只会抓取第一个单元格（在 A 列中）的值为 4、5、6、7 的行，或 8 （它会抓住那 5 行）。

我正在尝试做的事情有 5 个主要步骤：

1. 在工作簿中创建一个新工作表（我们称之为 QuoteCSV）
2. 让用户通过 UserForm 输入信息
3. 从用户窗体中获取该数据并将其填充到新 QuoteCSV 工作表上的一定数量的行中
4. 根据上述条件从 sheet1 复制某些行
5. 将这些行粘贴在与我在步骤 2 中填写的用户输入数据行相同的行上

到目前为止，我能够执行步骤 1-4。尝试执行第 5 步时出现错误。这是我的代码

Sub exportDataToCSVSheet()
    
    'STEP 1 - create new sheet
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "QuoteCSV"
    
   'set header names on first row of new sheet
    Dim setValue_Var As Range
    Set setValue_Var = Sheets("QuoteCSV").Range("A1:V1")
    setValue_Var.Value = Array("H.SalesOrderNo", "H.ARDivNum", "H.CustomerNum", "H.CustomerPONum", "H.OrderDate", "H.ShipToName", "H.ShipToAddress1", "H.ShipToAddress2", "H.ShipToCity", "H.ShipToState", "H.ShipToZipCode", "H.ShipVia", "L.ItemCode", "L.ItemType", "L.CommentText", "L.DropShip", "L.QuantityOrdered", "L.UnitPrice", "L.UnitCost", "L.SerialNumber", "L.RenewalStartDate", "L.RenewalEndDate")
    
    
    Sheets(1).Select 
    'this gets you back to the first sheet of the workbook which 
    'is where I will be grabbing rows for step 4
    

    'ask user for input line values, these are the lower and upper bounds I talked about earlier
    FirstL = Application.InputBox("First line item num", "Please enter num", , , , , , 1)
    LastL = Application.InputBox("Last line item num", "Please enter num", , , , , , 1)

    'LineCount will be how many rows of data I am grabbing from Sheet1 as well as how 
    'many rows I will populate with the userform data 
    LineCount = (LastL - FirstL) + 1
    
   

    'STEP 2 - here is where I get user data for header items
    Dim frm As New UserForm1

    ' Show as modal - code waits here until UserForm is closed
    frm.Show vbModal
    
    'grabbing values from userform
    fson = frm.son
    fdiv = frm.divnum
    fcnum = frm.custnum
    fcponum = frm.custponum
    Dim frdate As String
    frdate = frm.monthCB + "/" + frm.dayCB + "/" + frm.yearCB
    cname = frm.shipname
    add1 = frm.add1
    add2 = frm.add2
    city = frm.city
    state = frm.state
    zip = frm.zip
    shipvia = frm.shipcomp
    
    'STEP 3 - pasting the userform data onto the specified number of rows starting from A2 and down
     With Sheets("QuoteCSV")

        Sheets("QuoteCSV").Select

        ' Get the current row
        Dim curRow As Long
        If .Range("B1") = "" Then
            curRow = 1
        Else
            curRow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        End If

        'Add items to the first row (row 2)
        .Cells(curRow, 1) = fson
        .Cells(curRow, 2) = fdiv
        .Cells(curRow, 3) = fcnum
        .Cells(curRow, 4) = fcponum
        .Cells(curRow, 5) = frdate
        .Cells(curRow, 6) = cname
        .Cells(curRow, 7) = add1
        .Cells(curRow, 8) = add2
        .Cells(curRow, 9) = city
        .Cells(curRow, 10) = state
        .Cells(curRow, 11) = zip
        .Cells(curRow, 12) = shipvia

        'This copies the new row I just made down for however many rows of data we will be grabbing in step 4
        With .Range("A2:L2")
            .Resize(LineCount).Value = .Value
        End With

    End With
    
    
    'Make sure original sheet with data we want to grab next is now active sheet
    Sheets(1).Select
    
    
    ' Close the form
    Unload frm
    Set frm = Nothing
    
    
 
    'STEP 4 - code to grab rows that fit the criteria and move to new workbook

    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set wb1 = ThisWorkbook

    'filter for rows where the value in the first cell is within the correct range
    With wb1.ActiveSheet
        .AutoFilterMode = False
        .Range("A:A").AutoFilter Field:=1, Criteria1:=">=" & FirstL, _
        Operator:=xlAnd, Field:=1, Criteria2:="<=" & LastL
    End With


    Set sht2 = Sheets("QuoteCSV")

    'STEP 5 - I am trying to copy the rows and paste them on the same lines as the userform data
    'but i get an error which I will describe and show below
    With wb1.ActiveSheet.Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible)
        .EntireRow.Copy sht2.Range("M2")
    End With
   
    wb1.ActiveSheet.AutoFilterMode = False
    
    
End Sub

这是第 3 步之后新的 QuoteCSV 表的样子

我知道我正在执行第 4 步，因为如果我注释掉第 3 步的代码块，输入 8 和 11 作为我的上限和下限，然后在本节中将范围从“M2”更改为“A2”代码，：

With wb1.ActiveSheet.Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible)
        .EntireRow.Copy sht2.Range("A2")
End With

正确的行被粘贴，如下所示（忽略空白行 2）：

我想要做的以及我的代码试图做的是将数据放在用户表单数据旁边的行上。最终在运行我的代码后，我希望新工作表如下所示：

但是，当我尝试按原样运行上面的代码时，当我到达最后这一行时出现错误

'STEP 5 - I am trying to copy the rows and paste them on the same lines as the userform data
    'but i get an error which I will describe and show below
    With wb1.ActiveSheet.Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible)
        .EntireRow.Copy sht2.Range("M2")
    End With

这是错误：

我想提一提的是，目前我在新工作表的第一行中只有大约 33 个标题名称，但我知道我需要添加更多，因为数据超过了 33 个单元格。我尝试添加更多标题单元格以查看是否修复了它，但它仍然给了我同样的错误。

显然，我从原始工作表中获取的数据比我在步骤 3 中粘贴的用户表单数据更复杂（在某些单元格中具有格式和公式）。我不确定我是否收到该错误是因为这个或者如果它是别的东西，但我希望得到一些帮助来尝试解决这个问题。谢谢

标签： excelvbaparsingcopy