使用if语句将粘贴复制到另一个工作簿

时间:2016-04-21 00:03:40

标签: excel vba excel-vba

我想从vba excel中的另一个工作簿中复制另一个工作表中的某些值,但是我得知错误1004.这是我的代码

Sub copiar()
    Dim rng As Range
    Dim cell As Range
    Dim rng2 As Range
    Dim cell2 As Range


    Set rng2 = Range("A2:A5")
    Set rng = Workbooks("perfumes.xlsx").Sheets("hoja").Range("A4:A10")


    For Each cell In rng2
        For Each cell2 In rng
            If cell2 = cell Then Workbooks("perfumes.xlsx").Worksheets("Hoja 1").Range("K" & cell2.Row).Copy Range("H" & cell.Row)
        Next cell2
    Next cell

End Sub

无法识别错误发生的位置 我是非常新的宏,migth需要帮助,谢谢

2 个答案:

答案 0 :(得分:0)

您的代码没有任何问题,因此,运行时错误是一个数据问题,因此显示问题中的数据会有所帮助。您可以通过在此处模拟表格来显示数据,或者链接到Google电子表格之类的内容,或以某种方式显示给定行中的数据示例。

答案 1 :(得分:0)

我对代码很感兴趣,所以我稍微改了一下,以便更清楚它在做什么。这段代码与OP的代码完全相同;没有任何区别。还添加了一些评论。

Sub copiar()
    'Dim rng As Range
    Dim cell As Range
    'Dim rng2 As Range
    Dim cell2 As Range


    'active sheet
    'Set rng2 = ActiveSheet.Range("A2:A5")
    'rng2.Select

    'compare sheet
    Dim hojaSheet As Worksheet
    Set hojaSheet = Workbooks("perfumes.xlsx").Sheets("hoja")
    'Set rng = hojaSheet.Range("A4:A10")

    'source sheet
    Dim hoja1Sheet As Worksheet
    Set hoja1Sheet = Workbooks("perfumes.xlsx").Sheets("hoja 1")

    'compare each cell in range in the activeSheet
    For Each cell In ActiveSheet.Range("A2:A5").Cells
        'to each cell in range in hojaSheet
        For Each cell2 In hojaSheet.Range("A4:A10").Cells
            'if matching then copy from hoja 1 sheet to ActiveSheet
            If cell2 = cell Then
                Call hoja1Sheet.Range("K" & cell2.Row).Copy(ActiveSheet.Range("H" & cell.Row))
                Debug.Print "copy from: Hoja 1!" & "K" & cell2.Row & " > " & "copy to: ActiveSheet!" & "H" & cell.Row
            End If
        Next cell2
    Next cell

End Sub

不解决任何问题,但如果它有助于澄清代码的作用,则可能会有用。