title: VBA get values from 2 workbooks where value matches?
body: <p><strong>Scenario</strong></p>
  
  <p>I have three workbooks</p>
  
  <pre><code>Master
  Planner
  Phonebook
  </code></pre>
  
  <p>In my master workbook, i have a value in cell I8 on sheet 1.</p>
  
  <p>Master (Sheet 1)</p>
  
  <pre><code>I8 = 2
  </code></pre>
  
  <p>On sheet 2 i have the following empty columns:</p>
  
  <p>Master (Sheet 2)</p>
  
  <pre><code>Column A (number)      Column B (Supplier)     Column C (Contact)
  </code></pre>
  
  <p>I intend to populate these columns with data from both planner workbook and phonebook workbook.</p>
  
  <p>In my planner, I have a list of numbers in column A and suppliers in Column N.</p>
  
  <pre><code>Numbers     Supplier    
  2           A
  2           B
  2           C
  3           D
  4           E
  2           F
  </code></pre>
  
  <p>I am trying to copy all the suppliers from my planner workbook that match the value in cell I8 (in this instance it is 2).</p>
  
  <p>I am pasting the numbers (2) in column A and pasting the supplier names into column B in master workbook.</p>
  
  <p>My code already copies and pastes these values fine.
  (I am also copying other values from planner into other columns in master - but for this question, these are not relevant).</p>
  
  <p>So this part of my code works fine.</p>
  
  <p><strong>The problem</strong></p>
  
  <p>Once the suppliers have been pasted into column B in master workbook - I also want to copy the contact name for each supplier from my workbook phonebook.</p>
  
  <p>My phonebook workbook has sheets A-Z and suppliers are listed under these sheets alphabetically. </p>
  
  <p>Phonebook:</p>
  
  <pre><code>    Supplier (Column A)       Contact Name (Column C)
  
      A                            Linda
      Aa                           Dave
      Aa                           Terry
      AB                           James
  
  A | B | C | D etc...    &lt;----- Sheets
  </code></pre>
  
  <p>I need to look in each sheet in column A of the phonebook for a supplier name that matches the supplier name in column B (master). </p>
  
  <p>If the supplier name matches then I want to copy the contact name in column C over to master workbook column C.</p>
  
  <p>My result should look like this</p>
  
  <p>Master (Sheet 2)</p>
  
  <pre><code>Column A (number)      Column B (Supplier)     Column C (Contact)
  2                      A                       Linda
  2                      A                       Linda
  </code></pre>
  
  <p>Here's my code:</p>
  
  <pre><code>Option Explicit
  
  Sub CreateAnnounce()
  
  Dim WB As Workbook
  Dim WB2 As Workbook
  Dim i As Long
  Dim i2 As Long
  Dim j As Long
  Dim LastRow As Long
  Dim j2 As Long
  Dim LastRow2 As Long
  Dim ws As Worksheet
  
  'Open Planner
  On Error Resume Next
  Set WB = Workbooks("2017 Planner.xlsx")
  On Error GoTo 0
  If WB Is Nothing Then 'open workbook if not open
      Set WB = Workbooks.Open("G:\BUYING\Food Specials\2. Planning\1. Planning\1. Planner\8. 2017\2017 Planner.xlsx")
  End If
  
  'Open PhoneBook
  On Error Resume Next
  Set WB2 = Workbooks("Phone Book for Food Specials.xls")
  On Error GoTo 0
  If WB2 Is Nothing Then 'open workbook if not open
      Set WB2 = Workbooks.Open("G:\BUYING\Food Specials\1. General\Phone Book\Phone Book for Food Specials.xls")
  End If
  
  ' ======= Edit #2 , also for DEBUG ======
  With WB.Worksheets(1)
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
      j = 2
  
      For i = 1 To LastRow
  
  
          ' === For DEBUG ONLY ===
          Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("I8").Value)
  
  
          If CInt(ThisWorkbook.Worksheets(1).Range("I8").Value) = .Range("A" &amp; i).Value Then ' check if Week No equals the value in "A1"
  
                  ThisWorkbook.Worksheets(2).Range("A" &amp; j).Value = .Range("A" &amp; i).Value
                  ThisWorkbook.Worksheets(2).Range("B" &amp; j).Value = .Range("N" &amp; i).Value
                  ThisWorkbook.Worksheets(2).Range("H" &amp; j).Value = .Range("K" &amp; i).Value
                  ThisWorkbook.Worksheets(2).Range("I" &amp; j).Value = .Range("L" &amp; i).Value
  
                  ThisWorkbook.Worksheets(2).Range("J" &amp; j).Value = .Range("M" &amp; i).Value
                  ThisWorkbook.Worksheets(2).Range("K" &amp; j).Value = .Range("G" &amp; i).Value
  
                  ThisWorkbook.Worksheets(2).Range("L" &amp; j).Value = .Range("O" &amp; i).Value
                  ThisWorkbook.Worksheets(2).Range("M" &amp; j).Value = .Range("P" &amp; i).Value
  
                  ThisWorkbook.Worksheets(2).Range("N" &amp; j).Value = .Range("W" &amp; i).Value
                  ThisWorkbook.Worksheets(2).Range("O" &amp; j).Value = .Range("Z" &amp; i).Value
  
  
  
                  'Retrieve Contact Details for supplier
  
                  'Worksheet 1
  
  
  
                'Retrieve Contact Details for supplier
               With WB2.Worksheets(2)
              LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
              j2 = 2
  
              For i2 = 1 To LastRow2
              Dim rngToFill As Range
              Set rngToFill = .Range("C2")
  
              Do
  
              Debug.Print ThisWorkbook.Worksheets(2).Range("B" &amp; j2).Value
  
              If ThisWorkbook.Worksheets(2).Range("B" &amp; j2).Value Like .Range("A" &amp; i2).Value Then ' check if Company equals the value in "B1 Phonebook"
  
              ThisWorkbook.Worksheets(2).Range("C2").Value = .Range("C" &amp; i2).Value
  
              Set rngToFill = rngToFill.Offset(1, 0)
  
  
              End If
  
              Loop
  
              Next i2
              End With
  
  
  
  
  
  
  
  
  
  
             'Retrieve Contact Details for supplier - END
  
  
  
  
              End If
  
      Next i
  End With
  
  
  End Sub
  </code></pre>
  
  <p>For some reason, the code is Copying/pasting just 1 single contact name on the first row into master workbook.</p>
  
  <p>I am also aware that at the moment I am only looking across one sheet.</p>
  
  <pre><code>With WB2.Worksheets(2) 
  </code></pre>
  
  <p>I need this code to obviously look across all sheets for all supplier contact names.</p>
  
  <p>Please can someone show me where I am going wrong and how to get this code to work? Thanks in advance.</p>
  
  <p>EDIT:</p>
  
  <p>I have composed the code suggested by user @BjornBogers</p>
  
  <p>'Retrieve Contact Details for supplier</p>
  
  <pre><code>            Dim FoundCellRng As Range
              Dim ContactValue As String
              Dim SearchStr As String
  
              For i2 = 1 To 26
                  'Assuming --&gt; ThisWorkbook.Worksheets(2).Range("B1").Value is what you are looking for?
                  SearchStr = ThisWorkbook.Worksheets(2).Range("B2").Value
                  Set FoundCellRng = WB2.Worksheets(i2).Range("A2:A200").Find(SearchStr)
                  If (FoundCellRng Is Nothing) Then
                      'Didn't find anything
                  Else
                      'We found it
                      ContactValue = WB2.Worksheets(i2).Cells(FoundCellRng.Row, FoundCellRng.Column + 2).Value
                      ThisWorkbook.Worksheets(2).Range("C" &amp; j).Value = ContactValue
                      Exit For
                  End If
              Next i2
  
  
             'Retrieve Contact Details for supplier - END
  </code></pre>
  
  <p>However, this does the same thing, only one contact name is being entered in the top row but nothing more.</p>
  
  <p>EDIT 2:</p>
  
  <p>With the code @R3uK provided, i seem to be getting the following issues:</p>
  
  <p><a href="https://i.stack.imgur.com/v9Diw.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/v9Diw.png" alt="enter image description here"></a></p>
  
  <p>Supplier names and other values are not copying across correctly.
  The same value seems to repeat itself again and again in column I.</p>
  
  <p>For some reason, this code creates another sheet? What is this sheet for?</p>
  
  <p><a href="https://i.stack.imgur.com/QPUmW.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/QPUmW.png" alt="enter image description here"></a></p>
  
  <p>The code is incredibly slow and i am having to wait 20 minutes or more.
  Is there a way to speed this up?</p>