将数据从一个excel工作簿复制到另一个工作簿[重复]答案

【问题标题】：Copy data from one excel workbook to another workbook [duplicate]将数据从一个excel工作簿复制到另一个工作簿[重复]
【发布时间】：2014-07-07 20:05:51
【问题描述】：

例如，如果我想从工作簿 1 表 1 复制数据 ("B1:B8") 并将其粘贴到另一个工作簿表 1 的 ("D1:D8") 中，但这必须通过引用或比较单元格 (书 1 的 A1:A8) 和单元格 (C1:C8) 只有相同的值，然后粘贴，否则跳过或不执行任何操作。

示例：Book1 Sheet1 我已经排好队了；

科尔A科尔B 应用是的会议通过没有图片失败是的地图是的是的位不

现在在 Workbook 2 Sheet 1 中，我在 COL C 中给出，

科尔C 应用程序会议 gif 图片 gif 图片少量 gif

所以在 COL D 中，我必须仅粘贴那些 COL A 和 COL C 相等的值，如果它们不相等，则跳过或在 COL D 中不粘贴任何内容

我已经编写了类似这样的代码，但不幸的是它粘贴了所有内容！

Sub Copy_range()
Dim x As Workbook
Dim y As Workbook
Dim rng As Range
Dim c As Range
Dim i As Long

Set x = ActiveWorkbook
Set y = Workbooks.Open(x.Sheets(1).Range("G1"))

Set rng = x.Sheets(1).Range("A1:A8")
Set c = y.Sheets(1).Range("C1:C8")

  For i = 1 To i + 1


 If x.Sheets(1).Range("A1:A8").End(xlUp).Row = y.Sheets(1).Range("C1:C8").End(xlUp).Row Then

 x.Sheets(1).Range("B1:B8").Copy
 y.Sheets(1).Range("D1:D8").PasteSpecial

 y.Close
 End If
Next

End Sub

【问题讨论】：

这句话看得我头疼：So in COL D I have to paste values only for those COL A and COL C equal ones if those were not equal skip or paste nothing in COL D
对不起，只有在 Col A（工作簿 1 表 1）等于COL C（工作簿 2 表 1）如果不相等，则不粘贴任何内容

标签： vba excel

【解决方案1】：

您似乎正在尝试从一个范围到另一个范围进行查看？如果是这样，您可以使用类似以下的方法来查找 C 列中的每个值与 A 列和 B 列中的主值：

Sub LookupRange()
    On Error Resume Next
    For i = 1 To 8
        ActiveSheet.Range("D" & i) = _
            Application.WorksheetFunction.VLookup( _
                ActiveSheet.Range("C" & i), _
                ActiveSheet.Range("A1:B8"), _
                2, _
                False)
    Next i
End Sub

这将遍历单元格 C1..C8 并在单元格 A1..A8 中查找每个值。如果找到匹配项，则会将相应的值复制到 D 列。

对于你上面的例子，你会得到：

您需要做的就是修改代码以使用单独的工作表。

【讨论】：

【解决方案2】：

Sub CopyInput2Output()

    Dim wbkSRC As Workbook
    Dim wbkDES As Workbook
    Dim strNameSheetSRC As String
    Dim strNameSheetDES As String

    'strSrcFile = "C:\src.xls"
    'strDesFile = "C:\des.xls"
    Set wbkSRC = Workbooks.Open(strSrcFile)
    Set wbkDES = Workbooks.Open(strDesFile)
    'Set wbkSRC = ThisWorkbook
    'Set wbkDES = ThisWorkbook

    strNameSheetSRC = 1   '  "input"
    strNameSheetDES = 1   '  "output"



    ' your selection : Sheets(1)
    wbkSRC.Worksheets(strNameSheetSRC).Range("A1:A8").Copy

    ' your selection : Sheets(1)
    With wbkDES.Worksheets(strNameSheetSRC)
        Range("C1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    End With

    MsgBox ("Just a check : CopyInput2Output()")

End Sub

【讨论】：