VBA-Kopieren und Einfügen von Werten Aus Separaten Bereichen Und Fügen Sie Auf Gleiche Blatt, die Gleiche Zeilen-Offset, Spalten (Wiederholen Für Mehrere Blätter)

Ich würde eine Case-Anweisung, aber ich glaube nicht, dass macht viel Sinn, in dieser situation, ich bin ein VBA-n00b, da dieser Arbeitsmappe bleiben ziemlich statisch, die ich nicht Verstand, unter den nicht-optimalen Ansatz und ein makro aufzeichnen, der mir das kopieren und einfügen, aber ich dachte, ich würde hier Fragen, bevor ich Lande.

Ich habe 6 Arbeitsblätter in 1 Arbeitsmappe.

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

Und fügen Sie die oben genannten Exemplare in der identischen Reihen, jedoch in den Spalten AE:BIN der gleichen Platte (einfach-offset).

Wenn jemand lenken mich in die richtige Richtung für dieses konnte ich wiederholen, dass die Lösung für die anderen 5 Blätter, wo ich die haben zu tun die gleiche Idee, aber für unterschiedliche Zeilen-und Spalten.

Jede Hilfe würde geschätzt, danke!

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
Haben Sie einen Blick auf stackoverflow.com/questions/21867497/..., dies gibt Ihnen all die Dinge, die Sie benötigen, wie .Offset() und einfügen. Versuchen Sie, einige code und veröffentlichen, was Sie haben, wenn Sie nicht Recht bekommen, es funktioniert - es wird ermutigt, zu versuchen, den code selbst zuerst, bevor Sie um Hilfe bitten.
Ich habe aktualisiert die oben zu zeigen, wie weit ich gekommen sind, gibt es doch einige Weise zu machen, dass mehr machbar?

InformationsquelleAutor user979226 | 2014-02-19

  1. 1

    Etwas wie das folgende genügen würde:

    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

    In der Regel verwenden Sie code wie diesen, um es mehr Dynamik, wenn Sie eine Kriterien wählen Sie die zu kopierenden Zeilen. Zum Beispiel, wenn Sie kopieren möchten, alles, wo der Wert in der Spalte BA equals "1234" (dies kann jede Art von Kriterien, die ich gerade abgeholt, ein schönes, einfaches) dann den folgenden Zyklus durch die Spalte BA und kopieren Sie alle Zeilen, in denen 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
    Ich war mit dem obigen code zu halten, die dynamischen, wie gesagt, das funktionierte perfekt, danke!

    InformationsquelleAutor Simon1979

Schreibe einen Kommentar