这是我能够在该主题上找到的基本上所有其他线程的变体。
我有一个工作表（我们在wbk2中说sh1），列B2：D8中的值。我需要遍历单元格并将数据复制到wbk1的sh1中的B2：D8。范围永远不会改变，但值会。并且，我想使用循环而不是简单的复制和粘贴。
接下来，我有一个不同的工作表（wbk3中的sh1）具有相同的范围。我想循环并复制单元格值，但这一次，我想增加已存在的值，而不是粘贴到wbk1。我想要最终得到的是wbk 2和3中特定单元格中的值的总和，粘贴到wbk1中的同一单元格中。
的伪代码：
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
任何开始提示都表示赞赏。
编辑：
使用下面的YowE3K帮助，代码现在是：
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
现在列出了正确的工作簿和工作表。在此代码之前，运行单独的代码以为每个工作簿/工作表提供B2：D8范围内的数据。 我现在唯一的问题是，当代码运行到以＆＃34; combinedReports.Worksheets＆＃34; .......开头的行时，我得到一个424对象需要运行时错误。我检查了一下，确保声明了所有变量，它们似乎是。鉴于此错误，这是否意味着我仍然在某处丢失声明？仅供参考，在此之前的所有其他工作都没有问题，因此可能只是这行输入错误。
编辑：整个代码粘贴在下面，其中包括在失败的行之前调用的2组代码...
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
答案 0 :(得分：0)
基于评论，您唯一的问题是进行循环，那么以下代码应该实现您想要的。 （请注意，此代码使用“伪代码”中提到的wbk1等，就像它们是对相关工作表的引用一样。）
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
如果您将当前代码（除循环之外的所有内容）粘贴到问题中，那么可以根据您的具体情况更好地定制。