title: Copy specific cells based on a criteria, to sheets with same label as the criteria in another workbook
body: <p>I am trying to write a code for the following task, but I have been struggling a quite a bit.
  I have 2 workbooks, wb1 and wb2. 
  wb1 has a table with a list of names in column A, then column B-V has the data I want to copy to the sheet with the same name as in column A but in a different book (wb2). The location its pasted to is also dependent on another criteria on the destination sheet in wb2. </p>
  
  <p>so for example in wb1 "John" is the name in A1, switch to wb2, go to the sheet called John, check the criteria on cell A4 of this sheet:
  There are 3 criteria which are: Teen, adult or Elder</p>
  
  <p>If Teen, then copy B1 into B97, copy C1 into B135, copy D1 into B147 &amp; B190, copy E4 into B1100</p>
  
  <p>If Adult, then  copy J1 into B97, copy F1 into B135, copy G1 into B147 &amp; B190, copy H4 into B1100</p>
  
  <p>If Elder, then copy B1 into B97, copy C1 into B135, copy D1 into B147 &amp; B190, copy E4 into B1100, copy J1 into B113, copy F1 into B1910, copy G1 into B1473 &amp; B1930, copy H4 into B1190</p>
  
  <p>(The above is just an example, there is a more cells to copy paste than listed above)</p>
  
  <p>This should be looped for all names in column A of wb1.</p>
  
  <p>Below is what macro record gave me, but it doesn't record the criterias. Both workbooks will be open btw.</p>
  
  <pre><code>    Sub Summary()
  
      Dim wb1 As Workbook
      Dim Sht As Worksheet
      Dim Rng, Rng2 As Range
  
      Set wb1= ThisWorkbook
      Set Sht = MasterBook.Worksheets("Sheet")
      Set Rng = Sht.Range("A2:A" &amp; Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row)
      Dim wb2 As Workbook
      Dim cell As Range
      For Each cell In Rng '&lt;---Here is where my first problem is, 
  'not sure how to get the excel to switch to the sheet 
  'with the same name as in column A then check cell A4 for the criteria'
  
      If cell.Value = "Teen" Then
      Range("C12").Select
          Selection.Copy
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=81
          Range("B97").Select
          ActiveSheet.Paste
          ActiveWindow.SmallScroll Down:=-9
          Windows("wb1.xlsx").Activate
          Range("D12").Select
          Application.CutCopyMode = False
          Selection.Copy
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=12
          Range("B95").Select
          ActiveSheet.Paste
          Windows("wb1.xlsx").Activate
          Range("E12").Select
          Application.CutCopyMode = False
          Selection.Copy
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=-45
          Range("B47").Select
          ActiveSheet.Paste
          ActiveWindow.SmallScroll Down:=63
          Range("B118").Select
          ActiveSheet.Paste
          Windows("wb1.xlsx").Activate
          Range("F12").Select
          Application.CutCopyMode = False
          Selection.Copy
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=48
          Range("B163").Select
          ActiveSheet.Paste
          Windows("wb1.xlsx").Activate
          Range("G12").Select
          Application.CutCopyMode = False
          Selection.Copy
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=-66
          Range("B93").Select
          ActiveSheet.Paste
          Windows("wb1.xlsx").Activate
          Range("H12").Select
          Application.CutCopyMode = False
          Selection.Copy
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=9
          Range("B105").Select
          Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
          ActiveWindow.SmallScroll Down:=60
          Range("B167").Select
          Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
              :=False, Transpose:=False
          Windows("wb1.xlsx").Activate
          Range("I12").Select
          Application.CutCopyMode = False
          Selection.Copy
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=-27
          Range("B141").Select
          ActiveSheet.Paste
          Windows("wb1.xlsx").Activate
          Range("J12").Select
          Application.CutCopyMode = False
          Selection.Copy
          Windows("wb2.xlsx").Activate
          Range("B145").Select
          ActiveSheet.Paste
          ActiveWindow.SmallScroll Down:=138
          Windows("wb1.xlsx").Activate
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=51
          Range("B326").Select
          ActiveSheet.Paste
          ActiveWindow.SmallScroll Down:=12
          Range("B339").Select
          Application.CutCopyMode = False
          ActiveCell.FormulaR1C1 = "1"
          Range("B317").Select
          ActiveCell.FormulaR1C1 = "1"
          Range("B312").Select
          ActiveCell.FormulaR1C1 = "1"
          Windows("wb1.xlsx").Activate
          Range("K12").Select
          Selection.Copy
          Windows("wb2.xlsx").Activate
          Range("B107").Select
          ActiveSheet.Paste
          ActiveWindow.SmallScroll Down:=-63
          Range("B49").Select
          ActiveSheet.Paste
          ActiveWindow.SmallScroll Down:=-9
          Windows("wb1.xlsx").Activate
          Windows("wb2.xlsx").Activate
          ActiveWindow.SmallScroll Down:=306
          Windows("wb1.xlsx").Activate
  
      else If cell.Value = "Adult" Then
      '&lt;-----same stuff as above for different cells copy pasted'
      else If cell.Value = "Elder" Then
      '&lt;-----same stuff as above for different cells copy pasted'
   end if
      End Sub
  </code></pre>
  
  <p>Also I don't know if the case function would be useful instead of the If statement here either.</p>
  
  <p>Thanks a lot in advance</p>
  
  <p><strong>EDIT 1</strong></p>
  
  <p>I changed the code as suggested below</p>
  
  <pre><code>Sub Summary()
  
      Dim wb1 As Workbook
      Dim Sht As Worksheet
      Dim Rng, Rng2 As Range
      Dim wb2 As Workbook
      Dim cell As Range
  
      Set wb1 = ThisWorkbook
      Set wb2 = Workbooks("Measure Templates.xlsx")
      Set Sht = wb1.Worksheets("Summary")
      Set Rng = Sht.Range("A5:A" &amp; Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row)
  
      For Each cell In Rng
          Select Case wb2.Sheets(cell.Text).Range("A4").Value
              Case "Standard Bathroom Template"
              wb1.Sheet("Summary").Range("B5").Value = wb2.ActiveSheet.Range("B97") '&lt;--- I'm getting an error here saying "Object doesn't support this property or method" 
  'I assume that this is not the right way to copy paste.
  'I looked around but everything online uses a specific sheet name for destination
  'which is not the case for me, it should be sheet with same name as in column A 
                  wb1.Sheet("Summary").Range("C5").Value = wb2.ActiveSheet.Range("B117")
                  Case "Standard Kitchen Template"
                  wb1.Sheet("Summary").Range("B6").Value = wb2.ActiveSheet.Range("B97")
                  wb1.Sheet("Summary").Range("C6").Value = wb2.ActiveSheet.Range("B117")
                  Case "Standard Bathroom and Kitchen T"
                  wb1.Sheet("Summary").Range("B7").Value = wb2.ActiveSheet.Range("B97")
                  wb1.Sheet("Summary").Range("C7").Value = wb2.ActiveSheet.Range("B117")
              End Select
          Next cell
  
      End Sub
  </code></pre>