VBA复制来自不同范围的粘贴值，并粘贴在同一张纸，同一行偏移列上（重复多张纸） [英] VBA Copy Paste Values From Separate Ranges And Paste On Same Sheet, Same Row Offset Columns (Repeat For Multiple Sheets)

问题描述

我本来要作一个Case语句，但在这种情况下我认为这不是很有意义，我是VBA n00b，因为该工作簿将保持静态，所以我不介意采用非最佳方法并记录了我要复制和粘贴的宏，但是我想我要先问一下这里。

I was going to make a Case statement but I don't think that makes much sense in this situation, I'm a VBA n00b, since this workbook will remain quite static I don't mind taking the non-optimal approach and record a macro of me copying and pasting but I thought I'd ask here before I land on that.

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

I have 6 worksheets in 1 workbook.

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

Sheet1: Copy BA17:BI31, Copy BA48:BI50, Copy BA67:BI81, Copy BA98:BI100, Copy BA117:BI131, Copy BA148:BI150, Copy BA167:BI181, Copy BA198:BI200, Copy BA215:BI215, Copy BA230:BI230, Copy BA246:BI260, Copy BA275:BI277

并将以上副本粘贴到相同的行中，但是列中AE：同一张纸上的AM（仅抵消）。

And paste the above copies into the identical rows, however in columns AE:AM of the same sheet (simply offset).

如果有人可以将我引导到正确的方向，我可以在其他5张纸上重复该解决方案

If someone can steer me in the right direction for this I could repeat that solution for the other 5 sheets where I have to do the same idea but for different row and columns.

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

Any help would be appreciated, thanks!

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

推荐答案

类似于以下内容足够了：

Something like the following would suffice:

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：

Generally you would use code like this to make it more dynamic, if you have a criteria to select which rows to copy. For example if you want to copy everything where the value in column BA equals '1234' (this can be any kind of criteria I have just picked a nice simple one) then the below would cycle through column BA and copy all the rows where 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复制来自不同范围的粘贴值，并粘贴在同一张纸，同一行偏移列上（重复多张纸）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！