How to copy certain rows to a different range on a different sheet using VBA in excel?

问题

The general idea of what I'm trying to do is copy certain rows from one sheet that meet a certain criteria (which I will explain in the next sentence), and then paste those rows in a different range on a newly created sheet in the same workbook. The criteria to grab a certain row is if the value in the first cell of that row is within a range specified by the user. For example, if the user enters in '4' for the lower bound and '8' for the upper bound, my code would only grab rows where the value in the first cell (in column A) is 4, 5, 6, 7, or 8 (it would grab those 5 rows).

There are 5 main steps to what I'm trying to do:

Create a new sheet in the workbook (lets call it QuoteCSV)
Have the user enter in information through a UserForm
Take that data from the UserForm and fill it in a certain number of rows on new QuoteCSV sheet
Copy certain rows from sheet1 based on criteria described above
Paste those rows on the same lines as the user-entered data rows that I filled in in step 2

So far, I'm able to do steps 1-4. I am getting an error when trying to do step 5. Here is my code


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

Here is what the new QuoteCSV sheet will look like after Step 3

I know I am doing Step 4 right because if I comment out the block of code for step 3, enter in 8 and 11 as my upper and lower bounds, and then change the range from "M2" to "A2" in this section of code,:

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

the correct rows are pasted in as shown here (disregard the blank row 2):

What I want to do, and what my code is trying to do is put that data on the lines next to the userform data. Ultimately after running my code, I want the new sheet to look like this:

However, when I try to run my code above as it is, I get an error when I get to this line at the end

'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

Here is the error:

One thing I want to mention is that I only have about 33 header names in the first row of the new sheet at the moment but I know I will need to add more because the data goes past 33 cells. I tried adding more header cells to see if that fixed it but it still gave me the same error.

Obviously the data I am grabbing from the original sheet is more complex (has formatting and formulas going on in some cells) than the userform data that I paste in in step 3. I'm not sure if I'm getting that error because of this or if it's something else, but I would love some help to try and figure this out. Thank you

来源：https://stackoverflow.com/questions/65296290/how-to-copy-certain-rows-to-a-different-range-on-a-different-sheet-using-vba-in

标签

excel

vba

parsing

copy