Excel VBA：如何从同一工作表复制多个范围 [英] Excel VBA: How to copy multiple ranges from same sheet

问题描述

我是VBA的新手。我有一个要复制并粘贴到新闻电子表格中的多个范围的工作表。第一个范围是C2：I37，下一个范围恰好在C38：I73下面的36个单元格开始，下一个范围恰好在C74：I109的下面36个单元格开始，依此类推。总共需要复制32个范围，所有范围都来自同一张纸，并且所有距离都相等。

I'm very new to VBA. I have a sheet that has multiple ranges I'd like to copy and paste into news spreadsheets. The first range is C2:I37, and the next begins exactly 36 cells below at C38:I73, and the next one exactly 36 cells below that at C74:I109, and so on. In total, there are 32 ranges that I need to copy, all from the same sheet, and all equal distance apart.

我可以在下面给出的宏中的第一个范围（C2：I37）上实现此目标（它做了一些与此问题无关的其他事情）。但是我不知道如何在剩余的31个范围内有效地做到这一点。任何反馈表示赞赏。

I can achieve this for the first range (C2:I37) in the macro given below (it does a few other things that are not relevant to this question). But I don't know how to do this in an efficient way for the remaining 31 ranges. Any feedback is appreciated.

Sub copy()
'
' copy Macro
'

'
    Range("C2:I37").Select
    Selection.copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "onsets1"
    ThisFile = Range("G1").Value
    ActiveWorkbook.SaveAs Filename:=ThisFile
    Range("G1").Select
    Selection.ClearContents
    ActiveWorkbook.Save
End Sub

推荐答案

您可以使用循环结构来做到这一点。我假设您的文件名也是每36个单元格，例如G1，然后是G37，等等。否则，我们将需要进行一些修改。

You can do this with a loop structure. I'm assuming that your filenames are also every 36 cells, e.g., G1, then G37, etc. If not, then we'll need to make some slight modification.

这避免了选择或激活任何内容的需要，并且通过直接赋值而不是使用Copy / PasteSpecial

This avoids the need to Select or Activate anything, and transfers values more efficiently via direct assignment rather than using Copy/PasteSpecial

（为每个复制的范围创建一个新的工作簿），可以更有效地传输值）

(This creates a new workbook for each copied range)

Dim rangeToCopy as Range
Dim fileNameRange as Range
Dim i as Long
Dim newWorkbook as Workbook
Dim fileName as String

With ThisWorkbook.Worksheets(" insert your worksheet name here")
    Set rngToCopy = .Range("C2:I37")
    Set fileNameRange = .Range("G1")
End With
For i = 1 to 32
    Set newWorkbook = Workbooks.Add
    newWorkbook.Worksheets(1).Range("A1").Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count).Value = rngToCopy.Value
    newWorkbook.Worksheets(1).Name = "onsets1"  ' Modify if needed
    fileName = fileNameRange.Value
    fileNameRange.ClearContents
    newWorkbook.SaveAs Filename:=fileName

    ' Increment our ranges:
    Set fileNameRange = fileNameRange.Offset(36)
    Set rngToCopy = rngToCopy.Offset(36)
Next
ThisWorkbook.Save

这篇关于Excel VBA：如何从同一工作表复制多个范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！