AW: Nur Werte einfügen - Funktioniert nicht
26.07.2018 01:19:10
fcs
Hallo Sait,
grundsätzlich kann es Probleme geben wenn im zu kopierenden Bereich oder im Zielbereich verbundenen Zellen vorkommen.
Damit es nicht zu Problemen im Ablauf der beiden Makros kommt ist es vermutlich besser wenn der zu kopierende Zellbereich als Parameter an das 2. Makro übergeben wird.
Dann kann der Kopierbefehl unmittelbar vor der PasteSpecial-Anweisung stehen.
Als weitere Möglichkeit könnten die Werte des zu kopierenden Bereichs einzeln im Zielblatt eingetragen werden.
Als weitere Möglichkeit den Ablauf zu stabilisieren sollten die Referenzen zu den Zellen immer komplett verwendet werden, wenn 2 Mappen in die Aktionen involviert.
Gruß
Franz
'Variante 1: Der zu kopierende Bereiche wir per PasteSpecial _
im Zielbereich eingefügt
Sub Test1()
Call datei_oeffnen(rngCopy:=ThisWorkbook.Sheets("Gesamt").Range("B4:M6"))
End Sub
Sub datei_oeffnen(rngCopy As Range)
Dim x As Long
Dim Pfad As String, Datei As String, Dateipfad_1 As String
Dim wkbZiel As Workbook
With ThisWorkbook.Worksheets("Eingabe")
Pfad = .Cells(9, 5).Value
Datei = .Cells(10, 5).Value
End With
Dateipfad_1 = Pfad & Datei & ".xlsx"
Set wkbZiel = Application.Workbooks.Open(Filename:=Dateipfad_1)
With wkbZiel.Worksheets(1) 'oder .Worksheets("Blattname")
x = .Range("B7").End(xlDown).Row
If x = .Rows.Count Then x = 7
rngCopy.Copy
.Cells(x + 1, 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Cells(x + 1, 2).Select
End With
wkbZiel.Save
' wkbZiel.Close savechanges = True
End Sub
'Variante 2: Die Zellen des kopierten Bereiches werden einzeln im _
Zielbereich eingetragen
Sub Test2()
Call datei_oeffnen_2(rngCopy:=ThisWorkbook.Sheets("Gesamt").Range("B4:M6"))
End Sub
Sub datei_oeffnen_2(rngCopy As Range)
Dim x As Long
Dim Pfad As String, Datei As String, Dateipfad_1 As String
Dim wkbZiel As Workbook
Dim Zeile As Long, Spalte As Long
With ThisWorkbook.Worksheets("Eingabe")
Pfad = .Cells(9, 5).Value
Datei = .Cells(10, 5).Value
End With
Dateipfad_1 = Pfad & Datei & ".xlsx"
Set wkbZiel = Application.Workbooks.Open(Filename:=Dateipfad_1)
With wkbZiel.Worksheets(1) 'oder .Worksheets("Blattname")
x = .Range("B7").End(xlDown).Row
If x = .Rows.Count Then x = 7
For Zeile = 1 To rngCopy.Rows.Count
For Spalte = 1 To rngCopy.Columns.Count
.Cells(x + 1, 2).Offset(Zeile - 1, Spalte - 1).Value = _
rngCopy.Cells(Zeile, Spalte).Value
Next Spalte
Next Zeile
End With
wkbZiel.Save
' wkbZiel.Close savechanges = True
End Sub