VBA从分开的范围复制粘贴值并粘贴在相同的工作表，相同的行偏移列（对多个表重复）
我打算做一个Case声明，但是我认为在这种情况下没什么意义，我是一个VBA n00b，因为这个工作簿将保持相当的静态我不介意采取非最优方法并loggingmacros的复制和粘贴，但我想在这之前，我会问在这里。
我有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列中（简单偏移）。
如果有人能把我引向正确的方向，我可以重复这个解决scheme，为其他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 像下面的东西就足够了：
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
一般来说，如果您有条件select要复制的行，则可以使用这样的代码使其更具dynamic性。 例如，如果要复制列BA中的值等于'1234'（这可以是任何types的标准，我刚刚select一个很好的简单的一个）的所有内容，那么下面将循环通过列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