title: Excel VBA - Copy data from one worksheet to another via loop
body: <p>This is a variant of basically every other thread I have been able to find on the topic.</p>
  
  <p>I have a worksheet (we'll say sh1 in wbk2) with values in columns B2:D8.  I need to loop through the cells and copy the data to B2:D8 in sh1 of wbk1.  The ranges will never change, but the values will.  And, I want to use a loop as opposed to a simple copy and paste.</p>
  
  <p>Next, I have a different worksheet (sh1 in wbk3) with the same range.  I want to loop through and copy the cell values, but this time, instead of pasting to wbk1, I want to increment the value that is already there.  What I want to end up with is a sum of the values in a particular cell in wbk's 2 and 3, pasted into that same cell in wbk1.</p>
  
  <p>Pseudo-code:</p>
  
  <pre><code>rng1 = wbk1.Range("B2:D8")
  rng2 = wbk2.Range("B2:D8")
  rng3 = wbk3.Range("B2:D8")
  For Each value In rng2
  Copy data to rng1
  Next value
  For Each value In rng3
  Merge data to rng1
  Next value
  </code></pre>
  
  <p>Any starting tips are appreciated.</p>
  
  <p>Edit:</p>
  
  <p>Using YowE3K's assistance from below, the code now is:</p>
  
  <pre><code>    Dim r As Long
      Dim c As Long
      For r = 2 To 8
          For c = 2 To 4
              combinedReports.Worksheets("combinedQualities").Cells(r, c).Value = snowq.Worksheets("qsum").Cells(r, c).Value + qual.Worksheets("qsum").Cells(r, c).Value
          Next
      Next
  </code></pre>
  
  <p>The correct workbooks and worksheets are now listed.  Before this code, separate code was run to give data in the B2:D8 ranges for each workbook/worksheet.
  The only issue I am having now is that when the code runs to the line starting with "combinedReports.Worksheets"......., I get a 424 object required run-time error.  I checked back to make sure all variables are declared, which they appear to be.  Given this error, does this mean I am still missing a declaration somewhere?  FYI, everything else before this works without issue, so it may be that it is just this line that is typed incorrectly.</p>
  
  <p>EDIT: The entire code is pasted below, which includes the 2 sets of code that are called right before the failing line...</p>
  
  <pre><code>Sub ReportCombiner()
  '
  ' ReportCombiner Macro
  '
  '
  'Create new workbook
      Dim combinedReports As Workbook, combinedCsats As Worksheet, combinedQualities As Worksheet, combinedTickets As Worksheet
      Set combinedReports = Workbooks.Add
      Sheets("Sheet1").name = "Combined CSAT's"
      Set combinedCsats = combinedReports.Sheets("Combined CSAT's")
      Sheets.Add After:=ActiveSheet
      Sheets("Sheet2").name = "Combined Qualities"
      Set combinedQualities = combinedReports.Sheets("Combined Qualities")
      Sheets.Add After:=ActiveSheet
      Sheets("Sheet3").name = "Combined Tickets"
      Set combinedTickets = combinedReports.Sheets("Combined Tickets")
  
  'Change analysts to variables
      Set Anal = Workbooks.Open("D:\Users\stefan.bagnato\Desktop\Analysts\Analysts")
      Dim var1, var2, var3, var4, var5, var6, var7 As String
      var1 = Workbooks("Analysts").Worksheets("Analysts").Range("A1")
      var2 = Workbooks("Analysts").Worksheets("Analysts").Range("A2")
      var3 = Workbooks("Analysts").Worksheets("Analysts").Range("A3")
      var4 = Workbooks("Analysts").Worksheets("Analysts").Range("A4")
      var5 = Workbooks("Analysts").Worksheets("Analysts").Range("A5")
      var6 = Workbooks("Analysts").Worksheets("Analysts").Range("A6")
      var7 = Workbooks("Analysts").Worksheets("Analysts").Range("A7")
      Workbooks("Analysts").Close
  
  'Qualities
      'Create quality table
          'Add table headers
              combinedQualities.Activate
              Range("A2") = var1
              Range("A3") = var2
              Range("A4") = var3
              Range("A5") = var4
              Range("A6") = var5
              Range("A7") = var6
              Range("A8") = var7
              Range("B1") = "Valid Qualities"
              Range("C1") = "Invalid Qualities"
              Range("D1") = "Total Qualities"
          'Justify cells
              Range("B2:D8").HorizontalAlignment = xlCenter
          'Format cells
              Range("A2:A8,B1:D1").Font.Bold = True
              Range("B1:D1").Font.Size = 12
          'Widen columns
              Range("A:A").ColumnWidth = 18
              Range("B:D").ColumnWidth = 16
      'Run SNOW Quality report
          Call ServiceNowQualityReport
      'Run CA Quality report
          Call CAQualityReport
      'Add data to combo table
          Dim r As Long
          Dim c As Long
          For r = 2 To 8
              For c = 2 To 4
                  combinedReports.Worksheets("combinedQualities").Cells(r, c).Value = snowq.Worksheets("qsum").Cells(r, c).Value + qual.Worksheets("qsum").Cells(r, c).Value
              Next
          Next
  
  End Sub
  
  
  
  Sub ServiceNowQualityReport()
  '
  ' ServiceNow Quality Report Macro
  '
  '
  'Create new workbook
      Dim snowq As Workbook, snowqws As Worksheet
      Set snowq = Workbooks.Add
      Sheets("Sheet1").name = "Qualities"
      Set snowqws = snowq.Sheets("Qualities")
  
  'Combine reports
      'Qualitied Incidents
          Set incq = Workbooks.Open("D:\Users\stefan.bagnato\Desktop\Latest Reports\snowincqual")
          Sheets("Page 1").name = "Qualitied Incidents"
          Set incqws = incq.Sheets("Qualitied Incidents")
          lastRowIncqws = incqws.Range("A" &amp; Rows.Count).End(xlUp).Row
          lastRowSnowqws = snowqws.Range("A" &amp; Rows.Count).End(xlUp).Row
          incqws.Range("A2:J" &amp; lastRowIncqws).Copy snowqws.Range("A" &amp; lastRowSnowqws)
          Workbooks("snowincqual").Close savechanges:=False
      'Qualitied RITM's
          Set ritmq = Workbooks.Open("D:\Users\stefan.bagnato\Desktop\Latest Reports\snowritmqual")
          Sheets("Page 1").name = "Qualitied RITM's"
          Set ritmqws = ritmq.Sheets("Qualitied RITM's")
          lastRowRitmqws = ritmqws.Range("A" &amp; Rows.Count).End(xlUp).Row
          lastRowSnowqws = snowqws.Range("A" &amp; Rows.Count).End(xlUp).Row + 1
          ritmqws.Range("A2:J" &amp; lastRowRitmqws).Copy snowqws.Range("A" &amp; lastRowSnowqws)
          Workbooks("snowritmqual").Close savechanges:=False
          Application.CutCopyMode = False
  
  'Format table
      'Add headers
          Range("A1") = "Ticket Number"
          Range("B1") = "Opened Date"
          Range("C1") = "Created By"
          Range("D1") = "Short Description"
          Range("E1") = "Quality Submitted Date"
          Range("F1") = "Quality By"
          Range("G1") = "Quality Reason"
          Range("H1") = "Quality Comments"
          Range("I1") = "Quality Resolved By"
          Range("J1") = "Quality Resolution Comments"
      'Widen columns and rows
          Columns("A:A").ColumnWidth = 15
          Columns("B:B").ColumnWidth = 18
          Range("C:C,I:I").ColumnWidth = 20
          Columns("D:D").ColumnWidth = 30
          Columns("E:G").ColumnWidth = 24
          Range("H:H,J:J").ColumnWidth = 40
          Rows("1:1").RowHeight = 20
          lastRow = Cells(Rows.Count, "A").End(xlUp).Row
          Range("A1:A" &amp; lastRow).RowHeight = 18
      'Justify cells
          Range("A1:J" &amp; lastRow).HorizontalAlignment = xlLeft
      'Format cells
          Range("B2:B" &amp; lastRow, "E2:E" &amp; lastRow).NumberFormat = "mm/dd/yyyy hh:mm:ss"
          Range("A1:J1").Font.Bold = True
          Range("A1:J1").Font.Size = 12
      'Wrap text
          Range("A1:J" &amp; lastRow).WrapText = True
      'AutoFit columns
          Range("D:D,H:H,J:J").Rows.AutoFit
  
  'Sort by Quality Submitted Date
      Worksheets("Qualities").Sort.SortFields.Add Key:=Range("E1"), SortOn:=xlSortOnValues, Order:=xlAscending
      With Worksheets("Qualities").Sort
          .SetRange Range("A2:J" &amp; lastRow)
          .Orientation = xlTopToBottom
          .Apply
      End With
  
  'Add new worksheet
      Sheets.Add
      Sheets("Sheet2").name = "Summed Data"
  
  'Change analysts to variables
      Set Anal = Workbooks.Open("D:\Users\stefan.bagnato\Desktop\Analysts\Analysts")
      Dim var1, var2, var3, var4, var5, var6, var7 As String
      var1 = Workbooks("Analysts").Worksheets("Analysts").Range("A1")
      var2 = Workbooks("Analysts").Worksheets("Analysts").Range("A2")
      var3 = Workbooks("Analysts").Worksheets("Analysts").Range("A3")
      var4 = Workbooks("Analysts").Worksheets("Analysts").Range("A4")
      var5 = Workbooks("Analysts").Worksheets("Analysts").Range("A5")
      var6 = Workbooks("Analysts").Worksheets("Analysts").Range("A6")
      var7 = Workbooks("Analysts").Worksheets("Analysts").Range("A7")
      Workbooks("Analysts").Close
  
  'Format table
      'Add table headers
          Range("A2") = var1
          Range("A3") = var2
          Range("A4") = var3
          Range("A5") = var4
          Range("A6") = var5
          Range("A7") = var6
          Range("A8") = var7
          Range("B1") = "Valid Qualities"
          Range("C1") = "Invalid Qualities"
          Range("D1") = "Total Qualities"
      'Justify cells
          Range("B2:D8").HorizontalAlignment = xlCenter
      'Format cells
          Range("A2:A8,B1:D1").Font.Bold = True
          Range("B1:D1").Font.Size = 12
      'Widen columns
          Range("A:A").ColumnWidth = 18
          Range("B:D").ColumnWidth = 16
  
  'Fill in data
      Dim qual As Worksheet, qsum As Worksheet, qRange As Range
      Set qual = Sheets("Qualities")
      Set qsum = Sheets("Summed Data")
      Set qRange = qual.Range("J2:J" &amp; lastRow)
      'Qualities
          qsum.Range("B2") = WorksheetFunction.CountIfs(qRange, "Valid on Kris" &amp; Search &amp; "*")
          qsum.Range("B3") = WorksheetFunction.CountIfs(qRange, "Valid on Matt" &amp; Search &amp; "*")
          qsum.Range("B4") = WorksheetFunction.CountIfs(qRange, "Valid on Shawn" &amp; Search &amp; "*")
          qsum.Range("B5") = WorksheetFunction.CountIfs(qRange, "Valid on Stefan" &amp; Search &amp; "*")
          qsum.Range("B6") = WorksheetFunction.CountIfs(qRange, "Valid on Trey" &amp; Search &amp; "*")
          qsum.Range("B7") = WorksheetFunction.CountIfs(qRange, "Valid on Tyler" &amp; Search &amp; "*")
          qsum.Range("B8") = WorksheetFunction.CountIfs(qRange, "Valid on Whitney" &amp; Search &amp; "*")
          qsum.Range("C2") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Kris" &amp; Search &amp; "*")
          qsum.Range("C3") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Matt" &amp; Search &amp; "*")
          qsum.Range("C4") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Shawn" &amp; Search &amp; "*")
          qsum.Range("C5") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Stefan" &amp; Search &amp; "*")
          qsum.Range("C6") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Trey" &amp; Search &amp; "*")
          qsum.Range("C7") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Tyler" &amp; Search &amp; "*")
          qsum.Range("C8") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Whitney" &amp; Search &amp; "*")
      'Sums
          Range("D2") = "=SUM(RC[-2]:RC[-1])"
          Range("D3") = "=SUM(RC[-2]:RC[-1])"
          Range("D4") = "=SUM(RC[-2]:RC[-1])"
          Range("D5") = "=SUM(RC[-2]:RC[-1])"
          Range("D6") = "=SUM(RC[-2]:RC[-1])"
          Range("D7") = "=SUM(RC[-2]:RC[-1])"
          Range("D8") = "=SUM(RC[-2]:RC[-1])"
  
      Application.CutCopyMode = False
  End Sub
  
  
  Sub CAQualityReport()
  '
  ' CA Quality Report Macro
  '
  '
  'Initialize workbook
      Dim CAQual As Workbook
      Set CAQual = Workbooks.Open("D:\Users\stefan.bagnato\Desktop\Latest Reports\qual")
      Sheets("RAW").name = "Qualities"
  
  'Remove the extra column and rows
      Rows("1:3").Delete Shift:=xlUp
      Range("A:A,E:G,L:Q,U:U,W:W").Delete Shift:=xlToLeft
  
  'Change analysts to variables
      Set Anal = Workbooks.Open("D:\Users\stefan.bagnato\Desktop\Analysts\Analysts")
      Workbooks("qual.xlsx").Activate
      Dim var1, var2, var3, var4, var5, var6, var7 As String
      var1 = Workbooks("Analysts").Worksheets("Analysts").Range("A1")
      var2 = Workbooks("Analysts").Worksheets("Analysts").Range("A2")
      var3 = Workbooks("Analysts").Worksheets("Analysts").Range("A3")
      var4 = Workbooks("Analysts").Worksheets("Analysts").Range("A4")
      var5 = Workbooks("Analysts").Worksheets("Analysts").Range("A5")
      var6 = Workbooks("Analysts").Worksheets("Analysts").Range("A6")
      var7 = Workbooks("Analysts").Worksheets("Analysts").Range("A7")
      Workbooks("Analysts").Close
  
  'Remove all analysts not wanted in the table
      Dim Names As String, r As Range
      lastRow = Cells(Rows.Count, "A").End(xlUp).Row
      Names = "Dana IT Service Catalog,Kristopher Snyder,Matthew Williams,Shawn Dwyer,Trey Skandier,Tyler Brown,Stefan Bagnato,Whitney Royal"
      ary = Split(Names, ",")
      Set r = Range("A1:X" &amp; lastRow)
      With r
          .AutoFilter Field:=4, Criteria1:=(ary), Operator:=xlFilterValues
      End With
  
  'Add a new worksheet
      Sheets.Add
      Sheets("Sheet1").name = "Summed Qualities"
  
  'Format table
      'Add table headers on the new sheet
          Range("A2") = var1
          Range("A3") = var2
          Range("A4") = var3
          Range("A5") = var4
          Range("A6") = var5
          Range("A7") = var6
          Range("A8") = var7
          Range("B1") = "Valid Qualities"
          Range("C1") = "Invalid Qualities"
          Range("D1") = "Total Qualities"
      'Format the table
          Range("A2:A8,B1:D1").Font.Bold = True
          Range("A:A").ColumnWidth = 18
          Range("B:D").ColumnWidth = 15
  
  'Fill in data
      Dim q As Worksheet, qsum As Worksheet, qual As Range
      Set q = Sheets("Qualities")
      Set qsum = Sheets("Summed Qualities")
      Set qual = Sheets("Qualities").Range("K1:K" &amp; lastRow)
  
  'Find the values
      qsum.Range("B2") = WorksheetFunction.CountIfs(qual, "Valid on Kris" &amp; Search &amp; "*")
      qsum.Range("B3") = WorksheetFunction.CountIfs(qual, "Valid on Matt" &amp; Search &amp; "*")
      qsum.Range("B4") = WorksheetFunction.CountIfs(qual, "Valid on Shawn" &amp; Search &amp; "*")
      qsum.Range("B5") = WorksheetFunction.CountIfs(qual, "Valid on Stefan" &amp; Search &amp; "*")
      qsum.Range("B6") = WorksheetFunction.CountIfs(qual, "Valid on Trey" &amp; Search &amp; "*")
      qsum.Range("B7") = WorksheetFunction.CountIfs(qual, "Valid on Tyler" &amp; Search &amp; "*")
      qsum.Range("B8") = WorksheetFunction.CountIfs(qual, "Valid on Whitney" &amp; Search &amp; "*")
  
      qsum.Range("C2") = WorksheetFunction.CountIfs(qual, "Feedback NA for Kris" &amp; Search &amp; "*")
      qsum.Range("C3") = WorksheetFunction.CountIfs(qual, "Feedback NA for Matt" &amp; Search &amp; "*")
      qsum.Range("C4") = WorksheetFunction.CountIfs(qual, "Feedback NA for Shawn" &amp; Search &amp; "*")
      qsum.Range("C5") = WorksheetFunction.CountIfs(qual, "Feedback NA for Stefan" &amp; Search &amp; "*")
      qsum.Range("C6") = WorksheetFunction.CountIfs(qual, "Feedback NA for Trey" &amp; Search &amp; "*")
      qsum.Range("C7") = WorksheetFunction.CountIfs(qual, "Feedback NA for Tyler" &amp; Search &amp; "*")
      qsum.Range("C8") = WorksheetFunction.CountIfs(qual, "Feedback NA for Whitney" &amp; Search &amp; "*")
  
  'Sum values
      Range("D2") = "=SUM(RC[-2]:RC[-1])"
      Range("D3") = "=SUM(RC[-2]:RC[-1])"
      Range("D4") = "=SUM(RC[-2]:RC[-1])"
      Range("D5") = "=SUM(RC[-2]:RC[-1])"
      Range("D6") = "=SUM(RC[-2]:RC[-1])"
      Range("D7") = "=SUM(RC[-2]:RC[-1])"
      Range("D8") = "=SUM(RC[-2]:RC[-1])"
  
      Application.CutCopyMode = False
  End Sub
  </code></pre>