Excel VBA:如何从同一工作表复制多个范围

时间:2018-07-28 14:04:07

标签: excel excel-vba copy-paste excel-2016

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

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

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

3 个答案:

答案 0 :(得分:3)

您可以使用循环结构来执行此操作。我假设您的文件名也是每36个单元格,例如G1,然后是G37,等等。如果没有,那么我们需要进行一些修改。

这避免了选择或激活任何内容的需要,并且通过直接分配而不是使用Copy / PasteSpecial来更有效地传输值

(这会为每个复制的范围创建一个新的工作簿)

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

答案 1 :(得分:1)

一些数学将为您提供范围。假设所有内容都放在一个工作簿中,因为我看不到您为工作簿设置任何新名称。

NOT EXISTS

如果转到其他工作簿,则需要一些代码来更改文件名,但是周围的代码可能是:

schedule

答案 2 :(得分:0)

根据您的宏修改此循环。

Dim a As Integer
Dim b As Integer

a = 2
b = 37

For x = 1 To 32

Sheets(act_ws).Activate
Range("C" & a & ":I" & b).copy
Sheets("Tempo").Activate
Range("C" & a & ":I" & b).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, transpoe:=False
a = a + 36
b = b + 36
Next