Zellen in eine andere Mappe kopieren
23.11.2016 15:28:43
Stefan
Der Name der Mappe mit dem Makro ist bekannt. Aus den zu kopierenden Blättern ist weder der Name im Vorhinein noch die genaue Anzahl der Blätter (zwischen 1 und 20) bekannt.
Ich habe ein bisschen herumprobiert, und 2 Testsmakros erstellt.
Das mit dem Kopieren funktioniert (zumindest in der Testversion) ganz gut.
Nur das Einfügen klappt nicht.
Der Plan wäre, dass die neuen Daten in die erste freie Zelle in Spalte A kopiert werdwn.
Wenn ich das Makro in dem Blatt ausführe, in das kopiert werden soll, funktioniert es perfekt. Jedes Mal ausführen werden die Daten unten an die Liste angehängt, beginnend mit A2 (A1 = Spaltenbeschriftung). Bin ich in derselben Mappe in einem anderen Blatt, werden die Daten auch nach A2 kopiert, aber bei mehrmaligen Ausführen werden die Daten in A2 nur überschrieben. Es findet anscheinend kein Update statt, dass die neue erste freie Zelle bestimmt. Bin ich in einer anderen Mappe wenn ich das Makro ausführe (was ich ja eigentlich will), dann werden die Daten nach A14 kopiert (Nur A1 beschriftet). Keine Ahnung warum.
Ich hoffe, dass ihr mir vielleicht Hinweise geben könnt, was ich falsch mache. Ich würde mich über ein bisschen Hilfe sehr freuen, da ich gerade echt nicht mehr weiter weiß.
Hier mein Versuch. Das Hauptdokument mit dem Makro heißt Zusammenfasser.xlsm
Sub einfügen()
Dim ErsteFreieZelle As Long
ErsteFreieZelle = Range("A65536").End(xlUp).Row + 1
With Workbooks("Zusammenfasser.xlsm").Sheets("Main").Range("A" & ErsteFreieZelle)
.PasteSpecial
End With
End Sub
Hier der Entwurf mit dem ich kopieren will. Ich würde die Formal für die fertige Version einfach kopieren und die Zahlen auf sheet(3) , (4) etc anpassen.
Sub Zeilekopieren()
Dim Anzahl As Integer
Anzahl = ActiveWorkbook.Worksheets.Count
Dim ErsteFreieZelle As Long
Sheets(1).Activate
ActiveWorkbook.Sheets(1).Range("a2", _
ActiveWorkbook.Sheets(1).Range("a2").End(xlDown).End(xlToRight)).Select
Selection.Copy
If Anzahl >= 2 Then
Sheets(2).Activate
ActiveWorkbook.Sheets(2).Range("a2", _
ActiveWorkbook.Sheets(2).Range("a2").End(xlDown).End(xlToRight)).Select
Selection.Copy
Else: End If
End Sub