Snasui Excel Forum

Code: Select all

Sub mylookupNewtran()
Dim lastrow As Long, wb As Workbook
Dim myrange As Range, tb As Workbook
Set tb = ThisWorkbook
With tb.Sheets(1)
lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
End With
Set wb = Workbooks.Open("D\Test\Database.xls")
Set myrange = wb.Sheets(1).Range("A:L")
On Error Resume Next
With tb.Sheets(1)
Sheets(1).Cells(7, 5).Value = Application.WorksheetFunction.VLookup(Cells(7, 5), myrange, 5, False)
Sheets(1).Cells(9, 5).Value = Application.WorksheetFunction.VLookup(Cells(7, 5), myrange, 5, False)
Sheets(1).Cells(11, 5).Value = Application.WorksheetFunction.VLookup(Cells(7, 5), myrange, 5, False)
Sheets(1).Cells(13, 5).Value = Application.WorksheetFunction.VLookup(Cells(7, 5), myrange, 5, False)
End With
wb.Close False
End Sub

Code: Select all

Sub mylookupNewtran()
    Dim lastrow As Long, wb As Workbook
    Dim myrange As Range, tb As Workbook
       Set tb = ThisWorkbook
            With tb.Sheets(1)
                lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
            End With
        Set wb = Workbooks.Open("C:\Users\Workbook\Test\Database.xlsm")
        Set myrange = wb.Sheets(1).Range("A1:L1728")
    On Error Resume Next
            With tb.Sheets(4)
                Sheets(4).Cells(7, 5).Value = Application.WorksheetFunction.VLookup(D5, myrange, 7, True)
                Sheets(4).Cells(9, 5).Value = Application.WorksheetFunction.VLookup(D5, myrange, 9, True)
                Sheets(4).Cells(11, 5).Value = Application.WorksheetFunction.VLookup(D5, myrange, 11, True)
                Sheets(4).Cells(13, 5).Value = Application.WorksheetFunction.VLookup(D5, myrange, 13, True)
            End With
        'wb.Close False
End Sub

Code: Select all

Sub mylookupNewtran()
    Dim lastrow As Long, wb As Workbook
    Dim myrange As Range, tb As Workbook
       Set tb = ThisWorkbook
            With tb.Sheets(1)
                lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
            End With
        Set wb = Workbooks.Open("C:\Users\Workbook\Test\Database.xlsm")
        Set myrange = wb.Sheets(1).Range("A1:L1728")
    On Error Resume Next
            With tb.Sheets(4)
                .Cells(7, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 7, 0)
                .Cells(9, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 9, 0)
                .Cells(11, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 11, 0)
                .Cells(13, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 13, 0)
            End With
        'wb.Close False
End Sub

Code: Select all

Sub mylookupNewTran()
    Dim lastrow As Long, wb As Workbook
    Dim mylookup As Range, tb As Workbook
        Set tb = ThisWorkbook
            With tb.Sheets(1)
                lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
            End With
        Set wb = Workbooks.Open("C:\WorkAA\Database\Database.xlsm")
        Set myrange = wb.Sheets(1).Range("A2:L1278")
    On Error Resume Next
            With tb.Sheets(1)
              .Cells(7, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 7, 0)
              .Cells(9, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 9, 0)
              .Cells(11, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 4, 0)
              .Cells(13, 4).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 10, 0)
              .Cells(7, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 6, 0)
              .Cells(9, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 12, 0)
              .Cells(13, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 5, 0)
              .Cells(5, 7).Value = Application.WorksheetFunction.VLookup(.[D5], myrange, 11, 0)
            End With
        wb.Close False
End Sub