Question

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

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.

另请参阅Avoid Using Select，了解如何将Worksheet对象用作变量。

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

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

2 个答案: