VBA – 复制并粘贴正确的数据

我无法将各种范围复制到相应的表单中。

dateRng = 12/19/2016 00:00:00 - 12/19/2016 23:59:59 num = 11 NumPts = 33 Sheets.Count = 16 

在这个例子中这是每个variables等于^的东西。

 Dim dateRng As String, num As Integer, j As Integer, sh As Worksheet dateRng = Sheets("Input Raw Data").Range("B" & counter + 2).Value num = Sheets("Tool Setup").Range("C18").Value NumPts = num * 3 For s = 1 To Sheets.Count For y = 1 To NumPts With Sheets(s) For j = 1 To num If .Name = j Then Sheets("Reporting").Range("A" & (12 * y - 7) & ":" & fConvertToLetter & (12 * y + 1)) _ .Copy (.Range("A2")) .Range("A1") = dateRng .Name = Sheets("Point Names").Range("B" & (3 * j - 1)) End If Columns("B:B").EntireColumn.AutoFit Next j End With Next y Next s 

所以目前,我正在将第一个范围复制到第一个相应的工作表中。 但之后它也粘贴到所有其余的表单中。 而不是将第二个范围与第二个表单配对。 在此先感谢您的帮助。

我不太明白这个问题。 如果你想通过不同的表格粘贴在不同的范围,我相信你的周期混合起来。

由于您的For j在内部运行对于s,您在传递到下一个表单之前先遍历第一个表单中的所有范围。

所以也许:

 For s = 1 To Sheets.Count For y = 1 To NumPts With Sheets(s) If .Name = s Then Sheets("Reporting").Range("A" & (12 * y - 7) & ":" & fConvertToLetter & (12 * y + 1)) _ .Copy (.Range("A2")) .Range("A1") = dateRng .Name = Sheets("Point Names").Range("B" & (3 * s - 1)) End If Columns("B:B").EntireColumn.AutoFit End With Next y Next s 

这只适用于如果我的理解正确,你想你的范围移动每下一张表。

我能够通过将“ For Statements分解为两个块来解决这个问题。

 For s = 1 To Sheets.Count With Sheets(s) For j = 1 To num If .Name = j Then .Range("A1:C1").Merge .Range("A1") = dateRng .Name = Sheets("Point Names").Range("B" & (3 * j - 1)) End If Next j End With Next s For s = 1 To Sheets.Count With Sheets(s) For y = 1 To NumPts If .Name = Sheets("Reporting").Range("B" & (12 * y - 5)) Then Sheets("Reporting").Range("A" & (12 * y - 6) & _ ":" & fConvertToLetter & (12 * y + 20)) _ .Copy (.Range("A2")) .Columns("A:A").ColumnWidth = 12 .Columns("B:B").EntireColumn.AutoFit End If y = y + 2 Next y End With Next s