0
votes

Objective: trying to perform index match/vlookup from workbook 2 to workbook 1

Backgrounds:

  1. VBA must be coded on workbook 3 due to workbook 1 & 2 are browsed by user.
  2. workbook 1 is always with one sheet only where sheetname = "sheet 1"
  3. workbook 2 would contain multiple worksheets where worksheets name and number of worksheets is variable

Below code is OK to copy data from 1ST sheet of workbook 2 to workbook 1.

What should be done so I could copy data from all the worksheets of workbook2 to workbook 1?

here is my code:

 Sub datacopy()

  'prompt user to select 1st workbook
 N = Application.GetOpenFilename _
 (Title:="Please choose OTS offline template file", _
 FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
 Set twb = Workbooks.Open(N)

 If N = False Then
 MsgBox "No file selected. Please click run again and select file", 
 vbExclamation, "Sorry!"
 Exit Sub
 Else
 End If

  'prompt user to select 2nd workbook
 R = Application.GetOpenFilename _
 (Title:="Please choose WIP information file", _
 FileFilter:="Excel Files *.xls*; *.csv (*.xls*; *.csv),")
 Set extwbk = Workbooks.Open(R)
 If R = False Then
 MsgBox "No file selected. Please click run again and select file.", 
 vbExclamation, "Sorry!"
 Exit Sub
 Else
 End If

 Dim Row As Long
 Dim Clm As Long

extwbk.Sheets(1).Activate

table1 = twb.Sheets("Sheet1").Range("A1:A5") 'lookup value in 1st workbook
table2 = extwbk.activesheet.Range("A2:D5") ' DataRange of vlookup array table in 2nd workbook

Row = twb.Sheets("Sheet1").Range("B2").Row    
Clm = twb.Sheets("Sheet1").Range("B2").Column   
On Error Resume Next

For Each cl In table1 
twb.Sheets("Sheet1").Cells(Row, Clm) 
Application.WorksheetFunction.VLookup(cl, table2, 3, False)  

Row = Row + 1
Next cl

extwbk.Close SaveChanges:=False

twb.Close SaveChanges:=True
MsgBox "Done"

End Sub
1

1 Answers

0
votes

To reach all sheet in Workbook2, do this:

Dim wbk1 as Workbook, wbk2 as Workbook
Dim sh1 as Worksheet, sh2 as Worksheet
Dim rTarget as Range

Set wbk1 = <name of workbook1>
Set sh1 = wbk1.Sheets("Sheet1")
Set wbk2 = <name of workbook2>

for each sh2 in wbk2
   Set r = sh2.Range("A1:F300")
   Set rTarget = sh1.Range(<Set the top left cell of the desired target>
   r.Copy Destination:=sh1.rTarget
   <do everything else what you want>
next sh2

You need to change the target range loop by loop in order not to overwrite the previous copy.