Excel VBA-通过循环将数据从一个工作表复制到另一个工作表

Question

This is a variant of basically every other thread I have been able to find on the topic.

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.

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.

Pseudo-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

Any starting tips are appreciated.

Edit:

Using YowE3K's assistance from below, the code now is:

    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

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.

EDIT: The entire code is pasted below, which includes the 2 sets of code that are called right before the failing line...

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" & Rows.Count).End(xlUp).Row
        lastRowSnowqws = snowqws.Range("A" & Rows.Count).End(xlUp).Row
        incqws.Range("A2:J" & lastRowIncqws).Copy snowqws.Range("A" & 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" & Rows.Count).End(xlUp).Row
        lastRowSnowqws = snowqws.Range("A" & Rows.Count).End(xlUp).Row + 1
        ritmqws.Range("A2:J" & lastRowRitmqws).Copy snowqws.Range("A" & 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" & lastRow).RowHeight = 18
    'Justify cells
        Range("A1:J" & lastRow).HorizontalAlignment = xlLeft
    'Format cells
        Range("B2:B" & lastRow, "E2:E" & 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" & 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" & 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" & lastRow)
    'Qualities
        qsum.Range("B2") = WorksheetFunction.CountIfs(qRange, "Valid on Kris" & Search & "*")
        qsum.Range("B3") = WorksheetFunction.CountIfs(qRange, "Valid on Matt" & Search & "*")
        qsum.Range("B4") = WorksheetFunction.CountIfs(qRange, "Valid on Shawn" & Search & "*")
        qsum.Range("B5") = WorksheetFunction.CountIfs(qRange, "Valid on Stefan" & Search & "*")
        qsum.Range("B6") = WorksheetFunction.CountIfs(qRange, "Valid on Trey" & Search & "*")
        qsum.Range("B7") = WorksheetFunction.CountIfs(qRange, "Valid on Tyler" & Search & "*")
        qsum.Range("B8") = WorksheetFunction.CountIfs(qRange, "Valid on Whitney" & Search & "*")
        qsum.Range("C2") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Kris" & Search & "*")
        qsum.Range("C3") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Matt" & Search & "*")
        qsum.Range("C4") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Shawn" & Search & "*")
        qsum.Range("C5") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Stefan" & Search & "*")
        qsum.Range("C6") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Trey" & Search & "*")
        qsum.Range("C7") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Tyler" & Search & "*")
        qsum.Range("C8") = WorksheetFunction.CountIfs(qRange, "Feedback NA for Whitney" & Search & "*")
    '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" & 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" & lastRow)

'Find the values
    qsum.Range("B2") = WorksheetFunction.CountIfs(qual, "Valid on Kris" & Search & "*")
    qsum.Range("B3") = WorksheetFunction.CountIfs(qual, "Valid on Matt" & Search & "*")
    qsum.Range("B4") = WorksheetFunction.CountIfs(qual, "Valid on Shawn" & Search & "*")
    qsum.Range("B5") = WorksheetFunction.CountIfs(qual, "Valid on Stefan" & Search & "*")
    qsum.Range("B6") = WorksheetFunction.CountIfs(qual, "Valid on Trey" & Search & "*")
    qsum.Range("B7") = WorksheetFunction.CountIfs(qual, "Valid on Tyler" & Search & "*")
    qsum.Range("B8") = WorksheetFunction.CountIfs(qual, "Valid on Whitney" & Search & "*")

    qsum.Range("C2") = WorksheetFunction.CountIfs(qual, "Feedback NA for Kris" & Search & "*")
    qsum.Range("C3") = WorksheetFunction.CountIfs(qual, "Feedback NA for Matt" & Search & "*")
    qsum.Range("C4") = WorksheetFunction.CountIfs(qual, "Feedback NA for Shawn" & Search & "*")
    qsum.Range("C5") = WorksheetFunction.CountIfs(qual, "Feedback NA for Stefan" & Search & "*")
    qsum.Range("C6") = WorksheetFunction.CountIfs(qual, "Feedback NA for Trey" & Search & "*")
    qsum.Range("C7") = WorksheetFunction.CountIfs(qual, "Feedback NA for Tyler" & Search & "*")
    qsum.Range("C8") = WorksheetFunction.CountIfs(qual, "Feedback NA for Whitney" & Search & "*")

'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

Answer 1

Based on comments that your only issue is doing the loop, then the following code should achieve what you want. (Note this code uses your wbk1 etc mentioned in the "pseudo-code" as if they are references to the relevant sheets.)

Dim r As Long
Dim c As Long
For r = 2 To 8
    For c = 2 To 4
        wbk1.Cells(r, c).Value = wbk2.Cells(r, c).Value + wbk3.Cells(r, c).Value
    Next
Next

If you paste your current code (which does everything other than the looping) into the question, then this could be tailored better to your specific situation.