Finding values ​​in a separate workbook and copying data to t…

I’ve been working on this one for a couple weeks now and I can’t seem to get it right. The concept seems easy which is why I’m so frustrated with it. I finally resorted to posting here for some input.

The idea behind this is similar to a vlookup (I tried vlookup and got a result I wasn’t looking for). On ThisWorkbook, I set “Desc” equal to cell B7. I then want to look this up in a separate workbook which is the database. Once “Desc” is found in the database, I want to copy the data in column D and paste it to the cell to the right of “Desc” in the original workbook. I need to repeat the Copy-Paste process for the rest of the cells in column B under “Desc”. Thanks in advance. Cheers.

Option Explicit

Dim i As Integer, n As Integer
Dim Desc As Range, ExDesc As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet

Sub Retrieve()
Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Import")
ws1.Range("C7:C100000").ClearContents

With ws1
    i = 7
    Do Until .Cells(i, 2) = ""
        Set Desc = ws1.Cells(i, 2)
        With Workbooks.Open("C:UsersUsernameDesktopDatabase.xlsm")
            Set wb2 = ActiveWorkbook
            Set ws2 = wb2.Sheets("Data")
            n = 2
            Do Until ws2.Cells(n, 2) = ""
                Set ExDesc = Cells(n, 2)
                If ExDesc = Desc Then
                    ExDesc.Offset(0,2).Copy
                End If
                n = n + 1
            Loop
        End With
        i = i + 1
    Loop
End With
End Sub

Public Sub Paste()
wb1.Activate
ws1.Cells(i, 3).Paste
End Sub

Untested:

Sub Retrieve()

Dim i As Integer, n As Integer
Dim Desc As Range, ExDesc As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngLookup As Range
Dim v

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Import")
ws1.Range("C7:C100000").ClearContents

Set wb2 = Workbooks.Open("C:UsersUsernameDesktopDatabase.xlsm")
With wb2.Sheets("Data")
    Set rngLookup = .Range(.Cells(7, 2), _
                    .Cells(7, 2).End(xlDown)).Resize(, 3)
End With

With ws1
    i = 7
    Do Until .Cells(i, 2) = ""
        v = Application.VLookup(.Cells(i, 2).Value, rngLookup, 3, False)
        If Not IsError(v) Then .Cells(i, 4).Value = v
        i = i + 1
    Loop
End With

wb2.Close False

End Sub
Hello, buddy!稿源:Hello, buddy! (源链) | 关于 | 阅读提示

本站遵循[CC BY-NC-SA 4.0]。如您有版权、意见投诉等问题,请通过eMail联系我们处理。
酷辣虫 » 后端存储 » Finding values ​​in a separate workbook and copying data to t…

喜欢 (0)or分享给?

专业 x 专注 x 聚合 x 分享 CC BY-NC-SA 4.0

使用声明 | 英豪名录