VBA Excel循环复制和粘贴

Question

我正在尝试循环代码，因此我不必每次都手动输入单元格范围。

子副本()

Dim x As Range
Dim y As Range
Set x = Range("C24361:F24363")
Set y = Range("P1")

x.copy
y.Select
ActiveSheet.Paste

x.Offset(5, 0).copy
y.Offset(3, 0).Select
ActiveSheet.Paste

x.Offset(10, 0).copy
y.Offset(6, 0).Select
ActiveSheet.Paste

x.Offset(15, 0).copy
y.Offset(9, 0).Select
ActiveSheet.Paste

x.Offset(54, 0).copy
y.Offset(12, 0).Select
ActiveSheet.Paste

x.Offset(59, 0).copy
y.Offset(15, 0).Select
ActiveSheet.Paste

x.Offset(64, 0).copy
y.Offset(18, 0).Select
ActiveSheet.Paste

x.Offset(69, 0).copy
y.Offset(21, 0).Select
ActiveSheet.Paste

x.Offset(108, 0).copy
y.Offset(24, 0).Select
ActiveSheet.Paste

x.Offset(113, 0).copy
y.Offset(27, 0).Select
ActiveSheet.Paste

x.Offset(118, 0).copy
y.Offset(30, 0).Select
ActiveSheet.Paste

x.Offset(123, 0).copy
y.Offset(33, 0).Select
ActiveSheet.Paste

x.Offset(162, 0).copy
y.Offset(36, 0).Select
ActiveSheet.Paste

x.Offset(167, 0).copy
y.Offset(39, 0).Select
ActiveSheet.Paste

x.Offset(172, 0).copy
y.Offset(42, 0).Select
ActiveSheet.Paste

x.Offset(177, 0).copy
y.Offset(45, 0).Select
ActiveSheet.Paste

结束子

现在我抓住指定的范围...并删除三个副本..粘贴..etc..一旦制作了 4 个副本...我需要删除 54 并运行相同的 drop 5 副本（所以 59）。 .并继续粘贴 3 滴...关于我如何完成这项任务的任何线索？

谢谢你

Answer 1

对于套装：

Option Explicit

Sub copySets()
    Const ITERATIONS As Long = 5    'repeated sets of 4 ranges appended
    Const TOTAL_UNIT As Long = 4    'one unit contains 4 ranges
    Const RNG_OFFSET As Long = 2    'one range is 3 rows
    Const TB         As Long = 54   'offset between units

    Dim ws As Worksheet, rng As Range, rngRows As Long, setRows As Long, fSet As Range
    Dim cl1R As Long, cl1C As Long, cl2R As Long, cl2C As Long, i As Long, j As Long

    Set ws = ThisWorkbook.ActiveSheet
    With ws
        cl1R = 7:   cl1C = 3:   cl2R = 9:   cl2C = 6  'Range("C7") and Range("F9")
        Set rng = .Range(.Cells(cl1R, cl1C), .Cells(cl2R, cl2C))

        rngRows = cl2R - cl1R + 1       'rows in range unit
        setRows = rngRows + RNG_OFFSET  'rows in range unit + offset rows between units

        For i = 1 To ITERATIONS
            If fSet Is Nothing Then Set fSet = rng Else Set fSet = Union(fSet, rng)
            For j = 1 To TOTAL_UNIT - 1
                Set fSet = Union(fSet, rng.Offset(setRows * j, 0))
            Next
            Set rng = .Range(.Cells(cl1R + (TB * i), cl1C), .Cells(cl2R + (TB * i), cl2C))
        Next

        fSet.Copy .Cells(((rngRows * j) * i) - ((rngRows * TOTAL_UNIT) * i) + 1, 16)
    End With
End Sub

---

测试文件：

加法：

复制城市：

Sub copyCities()
   Const CP As Long = 5    'copy-paste repeated (iterations)
   Const CC As Long = 2    'copy column (Col "B": cities)
   Const CO As Long = 54   'offset between copied cells (cities)
   Const PC As Long = 16   'paste column (Col "P" = 16)
   Const PO As Long = 12   'paste offset

   Dim i As Long

   With ThisWorkbook.ActiveSheet
    For i = 0 To CP - 1
     .Range(.Cells((i * PO) + 1, PC), .Cells((i * PO) + PO, PC)) = .Cells((CO * i) + 1, CC)
    Next
   End With
End Sub