有条理地将特定列复制到另一个工作表

时间:2014-11-18 03:25:49

标签: excel vba copy-paste worksheet

如果" YES"我在下面的示例将工作表1中的特定行复制到工作表2。在E列中找到 我需要它只复制行的特定列,B&下进行。

Fund Account Amount         Gain/Loss   As/Of? (Y/N)
1    11111    $15,000.00       -$1.51        YES
1    22222    $32,158.52       $78.14        YES
2    123123   $1.00         $0.00        NO

代码:

Sub As_Of_Analysis_Sorting()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("All Trades").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("E" & r).Value = "YES" Then
        Rows(r).Copy Destination:=Sheets("As-Of Trades").Range("A" & lr2 + 1)
        lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row
    End If

    Range("A1").Select
Next r
End Sub

2 个答案:

答案 0 :(得分:2)

试试这个:

Sub As_Of_Analysis_Sorting()
    Dim lr As Long, lr2 As Long, r As Long
    Set Sh1 = ThisWorkbook.Worksheets("All Trades")
    Set Sh2 = ThisWorkbook.Worksheets("As-Of Trades")
    Sh1.Select

    Sh2.Cells(1, 1).Value = "Account"
    Sh2.Cells(1, 2).Value = "Amount"
    lr = Sh1.Cells(Rows.Count, "A").End(xlUp).row
    x = 2
    For r = 2 To lr
        If Range("E" & r).Value = "YES" Then
            Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value
            Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value
            x = x + 1
        End If
    Next r
    Sh2.Select
End Sub

新请求:

Sub As_Of_Analysis_Sorting()
    Dim lr As Long, lr2 As Long, r As Long
    Set Sh1 = ThisWorkbook.Worksheets("All Trades")
    Set Sh2 = ThisWorkbook.Worksheets("As-Of Trades")
    Sh1.Select

    Sh2.Cells(1, 1).Value = "Account"
    Sh2.Cells(1, 2).Value = "Amount"
    lr = Sh1.Cells(Rows.Count, "A").End(xlUp).row
    x = 2
    For r = 2 To 30
        If Range("E" & r).Value = "YES" Then
            Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value
            Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value
            x = x + 1
        End If
    Next r
    x = 35
    For r = 31 To lr
        If Range("E" & r).Value = "YES" Then
            Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value
            Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value
            x = x + 1
        End If
    Next r
    Sh2.Select
End Sub

答案 1 :(得分:0)

您需要做的是使用计数器执行For,该计数器将从表格中读取所有单元格,从上到下。 F是您要放置内容的新工作表的行。

尝试类似的内容:

sub alfa()
    UF = Cells(Rows.Count, 1).End(xlUp).Row
    for i = 1 to uf
        if sheetname.cells(i,Columnofyes).value = "YES" then 
            sheetwheretocopy.cells(f,columnwheretocopy).value = sheetname.cells(i,columnofdata).value
            f=f+1
        end if
    next i
end sub