有条件地将Excel文件-2数据复制到Excel文件-1？

Question

我正在使用Excel2007。当某些列数据从文件-1与文件-2匹配时，我试图将单价从Excel文件-2数据复制到Excel文件-1。

我的VBA代码：

Sub mySales() 
    Dim LastRow As Integer, i As Integer, erow As Integer, Pipe_Class As String, Pipe_Description As String, End_Type As String, Pipe_Size As String
    Dim wbk As Workbook
    strPriceFile = "C:\Temp\File-2.xlsx"
    LastRow = ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
        Pipe_Class = ""
        Pipe_Description = ""
        End_Type = ""
        Pipe_Size = ""
        Pipe_Class = ActiveSheet.Cells(i, 1).Value
        Pipe_Description = ActiveSheet.Cells(i, 2).Value
        End_Type = ActiveSheet.Cells(i, 3).Value
        Pipe_Size = ActiveSheet.Cells(i, 4).Value
        Set wbk = Workbooks.Open(strPriceFile)
        Worksheets("SOR2").Select
        If Cells(i, 1) = Pipe_Class And Cells(i, 2) = Pipe_Description And Cells(i, 3) = End_Type And Cells(i, 4) = Pipe_Size Then
            Range(Cells(i, 12), Cells(i, 12)).Select
            Selection.Copy

??? After Here how select my current file & paste ????????

            Worksheets("SOR1").Select
            erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            ActiveSheet.Cells(erow, 12).Select
            ActiveSheet.Paste
            ActiveWorkbook.Save
        End If
    Next i
    ActiveWorkbook.Close
    Application.CutCopyMode = False
End Sub

Answer 1

我没有检查您的所有代码，但我已经重构了您的问题中的内容，试图打开工作簿一次，并分配适当的对象，以便您可以跟踪应用于哪个工作表的操作。

Sub mySales() 
    Dim LastRow As Integer, i As Integer, erow As Integer
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim wbDst As Workbook
    Dim wsDst As Worksheet
    Dim strPriceFile As String

    Set wbDst = ActiveWorkbook
    Set wsDst = ActiveSheet

    strPriceFile = "C:\Temp\File-2.xlsx"
    Set wbSrc = Workbooks.Open(strPriceFile)
    Set wsSrc = wbSrc.Worksheets("SOR2")

    LastRow = wsDst.Range("A" & wsDst.Rows.Count).End(xlUp).Row
    erow = LastRow + 1

    For i = 2 To LastRow
        If wsSrc.Cells(i, 1).Value = wsDst.Cells(i, 1).Value And _
           wsSrc.Cells(i, 2).Value = wsDst.Cells(i, 2).Value And _
           wsSrc.Cells(i, 3).Value = wsDst.Cells(i, 3).Value And _
           wsSrc.Cells(i, 4).Value = wsDst.Cells(i, 4).Value Then

            wsSrc.Cells(i, 12).Copy wsDst.Cells(erow, 12)
            erow = erow + 1  ' your current code would always copies to the same row,
                             ' but I **think** you probably want to copy to the
                             ' next row each time
        End If
    Next i

    wbSrc.Close
    If erow > LastRow + 1 Then
       wbDst.Save
    End If
    wbDst.Close
End Sub

代码完全未经测试，但是，即使它不能工作，至少它应该让您了解应该如何处理多个工作簿和多个工作表。