Question

我要从名为“价格表”的工作表中复制值，在该表中，我要从“第10行”开始复制的值仅应复制“列D”和“列F”。并将其粘贴到另一个名为“ Sheet1”的工作表中。它应该从“第25行”开始粘贴值，并粘贴在“ H列”和“ I列”下。

我想放置一个条件语句，仅复制“价格表”中“列D”中值大于“零”的行，并将其粘贴到“ H”列中的“ sheet1”中和“ 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

尝试以下代码：

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

Answer 2

我会为此任务使用一个过滤器，就像这样：

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

如何从一张值从特定行开始的工作表中复制值

2 个答案: