Блог

Общая идея того, что я пытаюсь сделать, — скопировать определенные строки с одного листа, которые соответствуют определенным критериям (которые я объясню в следующем предложении), а затем вставить эти строки в другой диапазон на вновь созданный лист в той же книге. Критерием для захвата определенной строки является то, находится ли значение в первой ячейке этой строки в пределах диапазона, указанного пользователем. Например, если пользователь вводит ‘4’ для нижней границы и ‘8’ для верхней границы, мой код будет захватывать только строки, где значение в первой ячейке (в столбце A) равно 4, 5, 6, 7 или 8 (это захватило бы эти 5 строк).

Есть 5 основных шагов к тому, что я пытаюсь сделать:

1. Создайте новый лист в рабочей книге (назовем его QuoteCSV)
2. Попросите пользователя ввести информацию через пользовательскую форму
3. Возьмите эти данные из пользовательской формы и заполните их определенным количеством строк на новом листе QuoteCSV
4. Скопируйте определенные строки из листа 1 на основе критериев, описанных выше
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" amp; .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:=">=" amp; FirstL, _
        Operator:=xlAnd, Field:=1, Criteria2:="<=" amp; 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" amp; LastRow).SpecialCells(xlCellTypeVisible)
        .EntireRow.Copy sht2.Range("M2")
    End With
   
    wb1.ActiveSheet.AutoFilterMode = False
    
    
End Sub
 

Вот как будет выглядеть новый лист QuoteCSV после шага 3

Я знаю, что правильно выполняю шаг 4, потому что, если я закомментирую блок кода для шага 3, введите 8 и 11 в качестве верхней и нижней границ, а затем измените диапазон с «M2» на «A2» в этом разделе кода,:

 With wb1.ActiveSheet.Range("A1:A" amp; 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" amp; LastRow).SpecialCells(xlCellTypeVisible)
        .EntireRow.Copy sht2.Range("M2")
    End With
 

Вот ошибка:

Одна вещь, которую я хочу упомянуть, это то, что на данный момент у меня есть только около 33 имен заголовков в первой строке нового листа, но я знаю, что мне нужно будет добавить больше, потому что данные превышают 33 ячейки. Я попытался добавить больше ячеек заголовка, чтобы посмотреть, исправлено ли это, но это все равно выдало мне ту же ошибку.

Очевидно, что данные, которые я беру с исходного листа, более сложны (в некоторых ячейках выполняется форматирование и формулы), чем данные пользовательской формы, которые я вставляю на шаге 3. Я не уверен, получаю ли я эту ошибку из-за этого или из-за чего-то другого, но я хотел бы получить помощь, чтобы попытаться разобраться в этом. Спасибо