将数据从一个Excel工作簿复制到另一个工作簿

时间:2014-05-19 18:41:00

标签: excel vba excel-vba

例如,如果我想从工作簿1表1复制数据(" B1:B8")并将其粘贴到另一个工作簿表1的(" D1:D8")中,但是这样必须通过参考或比较书1的单元格(A1:A8)和单元格(C1:C8)只有相同的值然后粘贴其他跳过或什么都不做。

示例:Book1 Sheet1我排队了;

COL A   COL B
app     yes
conf    pass
gif     no
pic     fail
bit     yes
map     yes
conf    yes
bit     no

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

COL C
app
conf
gif
pic
gif
pic
bit
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

2 个答案:

答案 0 :(得分:0)

看起来你正试图从一个范围到另一个范围进行查看?如果是这样,您可以使用类似下面的内容来查找列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列。

对于上面的例子,你得到:

enter image description here

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

答案 1 :(得分:0)

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