VBA: Unterschiedliche Zellen von Blatt "A" in unterschiedliche Zellen nach Blatt "B" kopieren?

Question

Guten Morgen Community!

Ist es per VBA möglich unterschiedliche Zellen in einem Rutsch aus dem aktiven Tabellenblatt zu kopieren und die Werte in unterschiedliche Zellen des vorgefertigten Tabellenblattes "Vorlage" einzufügen?

Aus dem aktiven Tabellenblatt sollen die Werte aus den Zellen:
E5, E6, E9, H9, E12, E16, H16, E17, H17, E19:O19 und nur die befüllten Zellen aus C58:M72 kopiert werden und in folgender Reihenfolge in die Zellen des Tabellenblattes "Vorlage" eingefügt werden:
E41, E42, E43, H43, E44, E16, H16, E17, H17, E19:O19, C58:M72.

Ich bedanke mich schonmal für das lesen und das sich annehmen meines Problemes!

Internette Grüsse
Mick

Answer 1

Nachtrag:

Für das einfügen des Tabellenblattes "Vorlage" habe ich diesen Code:

Public Sub Vorlage()
Application.ScreenUpdating = False

Sheets("Vorlage").Visible = True

ThisWorkbook.Worksheets("Vorlage").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
Range("E5").Select


Sheets("Vorlage").Visible = False

End Sub

Answer 2

Hi,

versuche es mal so (ungetestet):

Sub Uebertragen()
With Worksheets("Vorlage")
.Range("E41") = ActiveSheet.Range("E5")
.Range("E42") = ActiveSheet.Range("E6")
.Range("E43") = ActiveSheet.Range("E9")
.Range("H43") = ActiveSheet.Range("H9")
.Range("E44") = ActiveSheet.Range("E12")
.Range("E16") = ActiveSheet.Range("E16")
.Range("H16") = ActiveSheet.Range("H16")
.Range("E17") = ActiveSheet.Range("E17")
.Range("H17") = ActiveSheet.Range("H17")
.Range("E19:O19") = ActiveSheet.Range("E19:O19")
.Range("C58:M72") = ActiveSheet.Range("C58:M72")
End With
End Sub

Bis später,
Karin

Answer 3

Hallo Karin,

vielen Dank für Deinen Code!

Da der Code anscheinend Probleme mit zusamenhängenden Zellen hat, habe ich etwas mit dem Macrorecorder experimentiert. Dabei kam nachfolgendes Macro raus.
Ist es denn noch möglich in den Zellen E5, E41, C58:M72 falls ein Hyperlink gesetzt ist diesen mit zu kopieren?

Sub Partner_anlegen()

Sheets("Vorlage").Visible = True
ThisWorkbook.Worksheets("Vorlage").Copy After:=ActiveSheet
Sheets("Vorlage").Visible = False

ActiveSheet.Previous.Select

With Worksheets("Vorlage (2)")
.Range("E41") = ActiveSheet.Range("E5")
.Range("E42") = ActiveSheet.Range("E6")
.Range("E43") = ActiveSheet.Range("E9")
.Range("H43") = ActiveSheet.Range("H9")
.Range("E44") = ActiveSheet.Range("E12")
.Range("E16") = ActiveSheet.Range("E16")
.Range("H16") = ActiveSheet.Range("H16")
.Range("E17") = ActiveSheet.Range("E17")
.Range("H17") = ActiveSheet.Range("H17")
.Range("E5") = ActiveSheet.Range("E41")
.Range("E6") = ActiveSheet.Range("E42")
.Range("M5") = ActiveSheet.Range("M40")
.Range("E9") = ActiveSheet.Range("E43")
.Range("H9") = ActiveSheet.Range("H43")
.Range("E12") = ActiveSheet.Range("E44")
.Range("E19") = ActiveSheet.Range("E19")

Range("C58:M72").Select
Selection.Copy
Sheets("Vorlage (2)").Select
Range("C58:M72").Select
ActiveSheet.Paste
Application.CutCopyMode = False

End With
End Sub

Internette Grüsse
Mick

Answer 4

Hi Mick,

Sub Partner_anlegen()

Sheets("Vorlage").Visible = True
ThisWorkbook.Worksheets("Vorlage").Copy After:=ActiveSheet
Sheets("Vorlage").Visible = False

ActiveSheet.Previous.Select

With Worksheets("Vorlage (2)")
.Range("E42") = Range("E6")
.Range("E43") = Range("E9")
.Range("H43") = Range("H9")
.Range("E44") = Range("E12")
.Range("E16") = Range("E16")
.Range("H16") = Range("H16")
.Range("E17") = Range("E17")
.Range("H17") = Range("H17")
.Range("E6") = Range("E42")
.Range("M5") = Range("M40")
.Range("E9") = Range("E43")
.Range("H9") = Range("H43")
.Range("E12") = Range("E44")
.Range("E19") = Range("E19")
Range("E5").Copy .Range("E41")
Range("E41").Copy .Range("E5")
Range("C58:M72").Copy .Range("C58:M72")
End With
End Sub

Bis später,
Karin

Answer 5

Hallo Karin,

einfach perfekt, diese Macro hat mein Problem gelöst!

Internette Grüsse
Mick