Question

我打算做一个Case声明，但我认为在这种情况下没有多大意义，我是VBA n00b，因为这个工作簿将保持相当静态我不介意采用非最佳方法并且记录了我复制和粘贴的宏，但我想在我登陆之前我会问这里。

我在1个工作簿中有6个工作表。

Sheet1：复制BA17：BI31，复制BA48：BI50，复制BA67：BI81，复制BA98：BI100，复制BA117：BI131，复制BA148：BI150，复制BA167：BI181，复制BA198：BI200，复制BA215：BI215，复制BA230：BI230，复制BA246：BI260，复制BA275：BI277

将上述副本粘贴到相同的行中，但是在同一张纸的AE：AM列中（简单地偏移）。

如果有人可以引导我朝着正确的方向前进，我可以为其他5张纸重复这个解决方案，我必须做同样的想法，但不同的行和列。

任何帮助将不胜感激，谢谢！

Sub CopyPasteOffetColumns()

Range("BA17:BI31").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA48:BI50").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE48").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA67:BI81").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE67").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA98:BI100").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE98").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA117:BI131").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE117").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA148:BI150").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE148").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA167:BI181").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE167").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA198:BI200").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE198").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA215:BI215").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE215").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA230:BI230").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE230").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA246:BI260").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE246").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("BA275:BI277").Select
Application.CutCopyMode = False
Selection.Copy
Range("AE275").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

Answer 1

以下内容就足够了：

Sub CopyPasteOffetColumns()

Dim rng As Range

Set rng = Range("BA17:BI31")
With rng
    .Copy
    .Offset(0, -22).PasteSpecial (xlPasteValues)
End With

Set rng = Range("BA48:BI50")
With rng
    .Copy
    .Offset(0, -22).PasteSpecial (xlPasteValues)
End With

'Repeat for each range

End Sub

如果您有一个标准来选择要复制的行，通常您会使用这样的代码使其更具动态性。例如，如果你想要复制BA中的值等于'1234'的所有内容（这可以是我刚刚选择了一个很好的简单标准的任何一种标准），那么下面将循环通过列BA并复制BA中的所有行= 1234：

Sub CopyPasteOffetColumns()

Dim rng As Range, c As Range
Dim sh As Worksheet

Set sh = ActiveSheet

' Set the range to be the used cells in column BA (starting from BA1)
Set rng = Range("BA1:BA" & sh.Cells(sh.Rows.Count, "BA").End(xlUp).Row)

' Cycle through the cells and apply the criteria
For Each c In rng
    If c.Value = 1234 Then ' change criteria as required
        Range(c.AddressLocal, c.Offset(0, 8).AddressLocal).Copy
        c.Offset(0, -22).PasteSpecial xlPasteValues
    End If
Next c

End Sub

VBA从单独的范围复制粘贴值并粘贴在同一工作表，相同的行偏移列（重复多个工作表）

1 个答案: