leider bin ich noch ein Anfänger was Makros betrifft.
Folgendes Programm habe ich für meine Bedürfnisse an Beispiele aus dem Internet angepasst:
Public Sub Wertekopieren()
Application.ScreenUpdating = False
Dim wb1 As Workbook
Dim wb1pfad As String
Dim wb1name As String
Dim wb6 As Workbook
Dim wb6pfad As String
Dim wb6name As String
Dim wb1ws1 As Worksheet
Dim wb6ws1 As Worksheet
Dim bwbopen As Boolean
On Error GoTo Weiter
wb1pfad = "\Desktop\Makro_Test\" ' Datenarbeitsmappepfad Datenquelle
wb1name = "Testquelle.xlsx" ' Datenarbeitsmappename
wb6pfad = "\Desktop\Marko_Test\" ' Zielarbeitsmappepfad Datenablage
wb6name = "Testziel.xlsm" ' Zielarbeitsmappename
bwbopen = WorkbookIsOpen(wb1name)
If bwbopen = False Then
Workbooks.Open (wb1pfad & wb1name)
Else
End If
Set wb1 = Workbooks(wb1name)
Set wb6 = Workbooks(wb6name)
Set wb1ws1 = wb1.Worksheets("Zeitplan_1") ' _
Datenarbeitsmappentabelle 1
Set wb6ws1 = wb6.Worksheets("Zeitplan") ' Zielarbeitsmappentabelle
wb1ws1.Range("B4:AF4").Copy
wb6ws1.Range("B6:AF6").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
If bwbopen = False Then
wb1.Activate
ActiveWorkbook.Close
Else
End If
Range("B6").Select
Weiter:
On Error Resume Next
bwbopen = WorkbookIsOpen(wb1name)
If bwbopen = True Then
wb1.Activate
ActiveWorkbook.Close
Else
End If
Application.ScreenUpdating = False
End Sub
Function WorkbookIsOpen(WBName As String) As Boolean
On Error Resume Next
WorkbookIsOpen = Not Workbooks(WBName) Is Nothing
End Function
Jetzt würde ich gerne in einem ersten Schritt noch weitere Zeilen kopieren und in der Zieldatei einfügen.
So soll es aussehen:
Schritt 1:
Es werden die Zeilen 7, 10, 13, ... kopiert in der Quelldatei und in der Zieldatei werden die Daten in den Zeilen 13, 20, 27, ... eingefügt.
Schritt 2:
Es wird noch eine weitere Quelldatei hinzugefügt.
In dieser zweiten Quelldatei werden die Daten ebenfalls aus den Zeilen 4, 7, 10, 13, ... kopiert und in der Zieldatei (gleiche Datei wie in Schritt 1) in den Zeilen 14, 21, 27, ... eingefügt.
Es wäre super, wenn ihr "Profis" mir helfen könntet.
Vielen vielen Dank.
Gruss Peter