AW: Datenbereich in andere Datei kopieren
11.02.2020 18:28:48
fcs
Hallo Gerhard,
kann man mit folgendem Makro lösen.
Makro muss gestartet werden, wenn Datei "Bestelldaten.xlsm" die aktive Arbeitsmappe ist.
LG
Franz
Sub Bestelldaten_nach_Stammdaten_kopieren()
Dim Zeile_L As Long
Dim rngCopy As Range
Dim wkbStamm As Workbook, wksStamm As Worksheet
Dim bolOpen As Boolean
Dim wksBestell As Worksheet
Set wksBestell = ActiveWorkbook.Worksheets("Bestelldaten")
With wksBestell
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile_L = 1 Then
MsgBox "Im Blatt """ & wksBestell.Name & """ sind keine Bestelldaten vorhanden!"
Exit Sub
End If
Set rngCopy = .Range(.Cells(2, 1), .Cells(Zeile_L, 8))
End With
If fncCheck_Workbook_Open("Stammdaten.xlsm") Then
bolOpen = True
Set wkbStamm = Application.Workbooks("Stammdaten.xlsm")
Else
'Pfad anpassen wenn "Stammdaten.xlsm" in einem anderen Verzeichnis liegt!
Set wkbStamm = Application.Workbooks.Open(ActiveWorkbook.Path & "\" & "Stammdaten.xlsm") _
End If
Set wksStamm = wkbStamm.Worksheets("Stammdaten")
With wksStamm
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
rngCopy.Copy Destination:=.Cells(Zeile_L, 1)
End With
wkbStamm.Save
If bolOpen = False Then
wkbStamm.Close savechanges:=True
End If
MsgBox "Die Bestelldaten wurden nach ""Stammdaten.xlsm"" kopiert.", _
vbInformation + vbOKOnly, "Bestelldaten kopieren"
End Sub
Public Function fncCheck_Workbook_Open(strWorkbookName As String) As Boolean
'Prüft ob angegebene Datei in Excel geöffnet ist.
Dim wkb As Workbook
On Error GoTo Fehler
Set wkb = Application.Workbooks(strWorkbookName)
fncCheck_Workbook_Open = True
Exit Function
Fehler:
End Function