从另一个工作簿复制具有值的最后一行到活动工作簿

时间:2016-02-24 14:28:00

标签: excel vba excel-vba

我有35个文件和一个主文件。在文件中,Sheet1,D列的值为480和0.如何复制主文件Sheet3中D列中480的最后一行(来自所有35个文件)?到目前为止,我已经使用代码复制最后一行,但我无法在列D中搜索值,然后复制。我真的想从master中运行宏而不是从许多文件中运行(现在实际上是一个宏来打开所有文件并运行宏警察来复制最后一行但是现在我必须只复制具有480值的最后一行D列。谢谢。

Sub cop()

Dim lastS1Row As Long Dim nextS2Row As Long Dim lastCol As Long Dim s1Sheet As Worksheet, s2Sheet As Worksheet Dim source As String Dim target As String Dim path As String Dim DestLast As Long source = "Sheet1" path = "C:\Users\me\Desktop\2.xlsx" target = "Sheet3" Application.EnableCancelKey = xlDisabled Set s1Sheet = ThisWorkbook.Sheets(source) Set s2Sheet = Workbooks.Open(path).Sheets(target) lastS1Row = s1Sheet.Range("A" & Rows.Count).End(xlUp).Row nextS2Row = s2Sheet.Range("A" & Rows.Count).End(xlUp).Row + 1 lastCol = s1Sheet.Cells(1, Columns.Count).End(xlToLeft).Column For lCol = 1 To lastCol s2Sheet.Cells(nextS2Row, lCol) = s1Sheet.Cells(lastS1Row, lCol) Next lCol s2Sheet.Activate ActiveWorkbook.Close SaveChanges:=True s1Sheet.Activate End Sub

1 个答案:

答案 0 :(得分:0)

试试这个。我假设480是一个数字而不是一个字符串。我添加了一个If-Then来检查最后一行,D列是否等于480。

Sub cop()

    Dim lastS1Row As Long
    Dim nextS2Row As Long
    Dim lastCol As Long
    Dim s1Sheet As Worksheet, s2Sheet As Worksheet
    Dim source As String
    Dim target As String
    Dim path As String
    Dim DestLast As Long

    source = "Sheet1"
    path = "C:\Users\me\Desktop\2.xlsx"
    target = "Sheet3"
    Application.EnableCancelKey = xlDisabled
    Set s1Sheet = ThisWorkbook.Sheets(source)
    Set s2Sheet = Workbooks.Open(path).Sheets(target)
    lastS1Row = s1Sheet.Range("A" & Rows.Count).End(xlUp).row
    nextS2Row = s2Sheet.Range("A" & Rows.Count).End(xlUp).row + 1
    lastCol = s1Sheet.Cells(1, Columns.Count).End(xlToLeft).Column
    If (s1Sheet.Cells(lastS1Row, 4).Value = 480) Then ' This is where you check the last row, column D.
        For lCol = 1 To lastCol
            s2Sheet.Cells(nextS2Row, lCol) = s1Sheet.Cells(lastS1Row, lCol)
        Next lCol
    End If

    s2Sheet.Activate
    ActiveWorkbook.Close SaveChanges:=True
    s1Sheet.Activate

End Sub