时间戳

首页 > 解决方案 > 选择多个范围并一次粘贴一个

excel - 选择多个范围并一次粘贴一个

问题描述

我真的是 VBA 的初学者，我正在尝试复制一系列范围，并且需要一次粘贴一个（到偏移行工作）。

这张图片是我所拥有的： 这张图是我的

这张图片就是我想要的： 这张图片就是我想要的

为此，我只考虑基于范围的复制，仅奇数范围并粘贴到“F”列中，仅复制偶数范围并粘贴到“N”列中。

目前，我有这个代码。我工作得很好，但我有 20 个奇数范围和 20 个偶数范围。我需要一种简单的方法来重复这 20 次

        Range("A3:G7").Copy
        Worksheets("Car").Cells(Rows.Count, "F").End(xlUp).Offset(RowOffset:=1).PasteSpecial xlPasteAll
        Application.CutCopyMode = False

        Range("A15:G19").Copy
        Worksheets("Car").Cells(Rows.Count, "F").End(xlUp).Offset(RowOffset:=2).PasteSpecial xlPasteAll
        Application.CutCopyMode = False

        Range("A27:G31").Copy
        Worksheets("Car").Cells(Rows.Count, "F").End(xlUp).Offset(RowOffset:=2).PasteSpecial xlPasteAll
        Application.CutCopyMode = False

一起（这里我只显示代码的 3 次重复）。

    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Sheets("Car").Activate
    Range("F2:AA250").Delete
    Sheets("Summary").Activate

            Range("A3:G7").Copy
            Worksheets("Car").Cells(Rows.Count, "F").End(xlUp).Offset(RowOffset:=1).PasteSpecial xlPasteAll
            Application.CutCopyMode = False

            Range("A15:G19").Copy
            Worksheets("Car").Cells(Rows.Count, "F").End(xlUp).Offset(RowOffset:=2).PasteSpecial xlPasteAll
            Application.CutCopyMode = False

            Range("A27:G31").Copy
            Worksheets("Car").Cells(Rows.Count, "F").End(xlUp).Offset(RowOffset:=2).PasteSpecial xlPasteAll

            Application.CutCopyMode = False
            Range("F2").Activate
    Application.ScreenUpdating = True
End Sub

标签： excelvbarangepaste

解决方案

请试试这个简单的方法。只有你的第一个范围就足够了。代码可以根据迭代次数（奇数或偶数）将范围复制到适当的位置。您可以进行更多迭代，只需更改迭代次数 ( howMany)：

Sub CopyRange_()
Dim sh As Worksheet, nextRow As Long, howMany As Long
Dim rng As Range, i As Long, No As Long
Set sh = ActiveSheet
Set rng = sh.Range("A3:L8"): nextRow = rng.Cells(1, 1).Row
No = 2: howMany = 20
rng.Copy

 For i = 1 To howMany - 1
    If i Mod 2 = 0 Then
        sh.Range("A" & nextRow).Select: sh.Paste
        sh.Range("L" & nextRow).value = No: No = No + 1
    Else
        sh.Range("N" & nextRow).Select: sh.Paste
        sh.Range("Y" & nextRow).value = No: No = No + 1
        nextRow = nextRow + rng.Rows.Count
    End If
 Next i
End Sub

如果您需要更多行，选择适当的范围就足够了，而不是“A3:L8”。例如，“A3:L10”……

推荐阅读