循环遍历行，将单元格值复制到不同的工作表

可能非常简单 – 希望得到一些帮助。 我有一个36x36matrix，量化各种汽油等级相对于其他汽油等级的值。 我想编写一个循环，将每行移动到另一个工作表（按连续顺序），而不必一遍又一遍地复制和粘贴相同的代码（更改范围和工作表）。 感谢任何帮助。

Sheets("Formulas").Range("Z8:BI8").Copy With Sheets("CONV7.8RVP87OCT").Range("A10000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With Sheets("Formulas").Range("Z9:BI9").Copy With Sheets("CONV7.8RVP89OCT").Range("A10000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With Sheets("Formulas").Range("Z10:BI10").Copy With Sheets("CONV7.8RVP93OCT").Range("A10000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With Sheets("Formulas").Range("Z11:BI11").Copy With Sheets("CONV9.0RVP87OCT").Range("A10000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With 

Answer 1

当然。 您只需要将工作表作为参数发送到子例程。

 Private sub pasteFormula(ws as WorkSheet) With ws.Range("A10000").End(xlUp).Offset(1, 0) .PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False .PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End With End sub 

被调用如：

 dim ws as WorkSheet Set ws = Sheets("CONV7.8RVP87OCT") Sheets("Formulas").Range("Z8:BI8").Copy pasteFormulas(ws) ' next worksheet Set ws = Sheets("CONV7.8RVP89OCT") Sheets("Formulas").Range("Z9:BI9").Copy pasteFormulas(ws) ' etc... ' You might actually want to consider a for worksheets loop, but I'll leave that as an exercise for you to complete. 

另请参阅避免使用Select对于如何使用Worksheet对象作为variables的相当好的描述。

Answer 2

这个怎么样？

您需要定义目标工作表名称，例如数组中的"CONV9.0RVP87OCT" ， "CONV7.8RVP87OCT" ：

 Sub CopyRows() Dim sheets() As Variant, sourceData As Range, rw As Long Set sourceData = Worksheets("Formulas").Range("Z8:BI43") // your 36 x 36 matrix sheets = Array("Sheet2", "Sheet3") //add your sheet names in here... For rw = 1 To sourceData.Rows.Count sourceData.Rows(rw).Copy Destination:=Worksheets(sheets(rw - 1)).Range("A10000").End(xlUp).Offset(1, 0) Next rw End Sub