将选定的列表框项目复制到另一个但是相同的工作簿?

时间:2014-06-04 00:53:32

标签: vba excel-vba excel

我的问题是如何修改以下代码,以便将其复制并粘贴到另一个名为" Purged.xlsx"的工作簿中的另一个工作表(" Purged Cartons")中。我不想使用workbook.add,因为每次代码运行时我都不想创建新的工作簿。我想复制相同的命名工作簿。请指教。谢谢。

Dim book As Workbook

 Set book = Workbooks.Open("C:\Users\_tanwen\Documents\wyw6\Purged.xlsx")

      With Sheet1
            For Each index In myindex
                myid = ListBox3.List(index, 0)
                Set rtarget = .Range("A:A").Find(myid, [a1]) '~~> Assuming ID's in ColA
                If Not rtarget Is Nothing Then Worksheets("Sheet1").Range("A:A").Find(myid, [a1]).Resize(1, 8). _
                Copy book.Worksheets("Purged Cartons").Range("A" & Rows.Count).End(xlUp).Offset(1)
                rtarget.EntireRow.Delete
                counter = counter + 1
                Set rtarget = Nothing
            Next
            End With

我试着运行上面的代码。我的书#34;是打开但这行导致错误说未找到指定的名称。

Copy book.Worksheets("Purged Cartons").Range("A" & Rows.Count).End(xlUp).Offset(1)

1 个答案:

答案 0 :(得分:0)

我设法解决了这个问题。

解决方案是您必须为活动工作簿声明一个变量。

所以我修改了以下代码并且它有效。

Dim wb1 As Workbook
Dim wb2 As Workbook


Set wb1 = ActiveWorkbook --> add this
Set wb2 = Workbooks.Open("C:\Users\_tanwen\Documents\wyw6\Purged.xlsx")


    For Each index In myindex
    myid = ListBox3.List(index, 0)
    Set rtarget = .Range("A:A").Find(myid, [a1])         
    If Not rtarget Is Nothing Then add this -->wb1.Worksheets("Sheet1").Range("A:A").Find(myid,    [a1]).Resize(1, 8). _
    Copy wb2.Worksheets("Purged Cartons").Range("A" & Rows.Count).End(xlUp).Offset(1)
    rtarget.EntireRow.Delete
    counter = counter + 1
    Set rtarget = Nothing
    Next
    End With