как скопировать значения с одного листа, где значения начинаются с определенной строки

Question

Я хочу скопировать значения из листа с именем «Ценовой график», в который нужно скопировать значения, которые я хочу начать копировать из «Строка 10» и ТОЛЬКО «Столбец D» и «Столбец F».И вставьте его в другой лист с именем «Sheet1».Он должен начать вставлять значения из «строки 25» и вставить под «Столбец H» и «Столбец I».

Я хочу поместить оператор условия, в который я хочу скопировать только те строки, которые имеют значение больше нуля в столбце «D» на листе «Ценовой график», и вставить его в поле «sheet1» в столбце «Столбец».«H» и столбец «I», начиная с «строки 25».

Private Sub CommandButton1_Click()

a = Worksheets("PRICE SCHEDULE").Cells(Rows.Count, 1).End(xlUp).Row

For I = 2 To a
    If Worksheets("PRICE SCHEDULE").Cells(I, 4).Value = ">0" Then
        Worksheets("PRICE SCHEDULE").Rows(I).Copy
        Worksheets("Sheet1").Activate

        b = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Paste

        Worksheets("PRICE SCHEDULE").Activate
    End If
Next

End Sub

Я попытался сделать это и передал msgbox, чтобы увидеть результаты, но он не показывает результатов скопированных данных.

Пожалуйста, смотрите изображения для лучшего понимания.

Answer 1

Я бы использовал фильтр для этой задачи, например так:

Sub tgr()

    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim rDest As Range

    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("Price Schedule")
    Set wsDest = wb.Worksheets("Sheet1")
    Set rDest = wsDest.Cells(wsDest.Rows.Count, "H").End(xlUp).Offset(1)
    If rDest.Row < 25 Then Set rDest = wsDest.Range("H25")

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With wsData.Range("D9:F" & wsData.Cells(wsData.Rows.Count, "D").End(xlUp).Row)
        If .Row < 9 Then GoTo CleanExit     'No data
        .AutoFilter 1, ">0", xlFilterValues 'Filter on column D for values >0
        Intersect(.Worksheet.Range("D:D,F:F"), .Offset(1)).Copy 'Copy filtered values in columns D and F only
        rDest.PasteSpecial xlPasteValues    'Paste values only to destination
        .AutoFilter 'Clear filter
    End With

CleanExit:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Answer 2

Попробуйте что-то вроде кода ниже:

Option Explicit

Private Sub CommandButton1_Click()

Dim LastRow As Long, i As Long, b As Long

With Worksheets("PRICE SCHEDULE")
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

    For i = 10 To LastRow ' loop from row 10 and forward
        If .Range("D" & i).Value >= 0 Then
            ' first get the next empty row to paste
            b = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1

            ' copy column "D" to column "H"
            .Range("D" & i).Copy Destination:=Worksheets("Sheet1").Range("H" & b)
            ' copy column "F" to column "I"
            .Range("F" & i).Copy Destination:=Worksheets("Sheet1").Range("I" & b)
        End If
    Next
End With

End Sub