VBA: Werte mit Makro kopieren und einfügen

233 Aufrufe
Gefragt 14, Jul 2017 in Tabellenkalkulation von Makroschnacker
Guten Mittag liebes Forum,

ich möchte Datensätze aus verschiedenen Tabellenblättern in das Tabellenblatt "Datensätze" derselben Arbeitsmappe kopieren und untereinanderschreiben. Dabei sollen nur die Werte (und wenn möglich auch die Formate) kopiert werden, nicht jedoch die Formeln mit denen die Datensätze zuvor in den einzelnen Tabellenblättern ermittelt wurden.
Folgendes Makro habe ich mir bereits zusammen kopiert und es funktioniert auch soweit ganz gut - allerdings würde ich gerne programmieren, dass die Daten aus den einzelnen Tabellenblättern immer erst dort eingefügt werden, wo eine leere Zeile vorliegt, da die Länge der Datensätze aus den Tabellenblättern nicht konstant ist. Soll dann im Endeffekt so aussehen, dass die einzelnen Datensätze ohne Zwischenraum untereinander kopiert werden und keine Daten überschrieben werden.

Sub Kopieren()
Set Summarysheet = ThisWorkbook.Sheets("Datensätze")
Summarysheet.Rows.Delete xlUp 'clear summary sheet
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Datensätze" Then
Set DestCell = Summarysheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)
ws.Range("a5:u214").Copy
DestCell.PasteSpecial xlPasteValues
DestCell.PasteSpecial xlPasteFormats
End If
Next
Application.CutCopyMode = False
End Sub

Die Hilfe von einem der schlauen Köpfe dieses Forums würde mich sehr freuen.

Gruß Mr. M

8 Antworten

0 Punkte
Beantwortet 14, Jul 2017 von m-o Profi (11,031 Punkte)
Hallo,

dein Makro fügt doch die Daten untereinander ein, ohne dass Daten überschrieben werden.

Es könnte höchstens Probleme geben, wenn Spalte A leer ist, aber in der betreffenden Zeile in anderen Spalten noch Daten stehen.


Gruß

M.O.
0 Punkte
Beantwortet 17, Jul 2017 von Makroschnacker
Hallo,

du hast es erkannt. Genau das ist das Problem. Die Daten gehen immer über drei Zeilen, wobei in Spalte A jeweils in der ersten Zeile nur eine Identifikationsnummer steht, allerdings in den anderen Zeilen Spalte A leer ist.
Hast du irgendeine Lösung dafür?

Gruß Mr. M.
0 Punkte
Beantwortet 17, Jul 2017 von m-o Profi (11,031 Punkte)
Hallo,

das hättest du ja in deiner Problembeschreibung schon sagen können ;-).

Falls es in der Spalten B das Problem nicht gibt, dann ändere die Zeile
Set DestCell = Summarysheet.Cells(Rows.Count, 1).End(xlUp).Offset(1)

in
Set DestCell = Summarysheet.Cells(Rows.Count, 2).End(xlUp).Offset(1)

Falls die letzte Zeile immer in einer anderen Spalten sein kann, so kannst du das wie folgt lösen
Set DestCell = Summarysheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1

Das funktioniert aber nur ohne Fehler, wenn in deinem Summarysheet nur die Spalten A bis U genutzt werden.

Gruß

M.O.
0 Punkte
Beantwortet 18, Jul 2017 von Makroschnacker
Hallo,

vielen Dank! Die Antwort hilft mir schon mal sehr viel.
Ich hätte noch ein paar kleinere Probleme, bei denen mir vielleicht jemand helfen kann. Zunächst mal werden die Daten jetzt im Tabellenblatt "Datensätze" beginnend in Zelle B2 eingefügt. Es wäre allerdings gut, wenn die Daten mit Zelle A1 beginnend eingefügt werden.
Zum Zweiten würde ich gerne das Format der Daten aus den einzelnen Tabellenblättern beibehalten. Beispielsweise sind einige Zellen ursprünglich mit Farben hinterlegt, was beim Einfügen am besten erhalten bleiben soll.

Gruß Mr. M.
0 Punkte
Beantwortet 18, Jul 2017 von m-o Profi (11,031 Punkte)
Hallo,

versuch mal das folgende Makro:

Sub Kopieren()
Dim Summarysheet As Worksheet
Dim ws As Worksheet
Dim lngLast As Long

Set Summarysheet = ThisWorkbook.Sheets("Datensätze")
Summarysheet.Rows.Delete xlUp 'clear summary sheet

For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Datensätze" Then
'letzte beschriebene Zeile im Summarysheet feststellen
lngLast = Summarysheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Prüfen, ob diese Zeile leer ist, falls nein, Zähler um 1 erhöhen
If Application.CountA(Rows(lngLast)) > 0 Then lngLast = lngLast + 1

ws.Range("A5:U214").Copy
With Summarysheet.Cells(lngLast, 1)
.PasteSpecial xlPasteValues 'Werte einfügen
.PasteSpecial xlPasteFormats 'Formate einfügen
End With

End If
Next

Application.CutCopyMode = False

End Sub


Gruß

M.O.
0 Punkte
Beantwortet 18, Jul 2017 von Makroschnacker
Leider erhalte ich die folgende Fehlermeldung: "Laufzeitfehler '1004': Die SpecialCells-Eigenschaft des Range-Objektes kann nicht zugeordnet werden."
Kannst du mir da weiterhelfen?

Gruß Mr. M.
0 Punkte
Beantwortet 18, Jul 2017 von m-o Profi (11,031 Punkte)
Hallo,

bei mir läuft das Makro einwandfrei.
Aber ersetze mal die Zeile
lngLast = Summarysheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

durch
lngLast = Summarysheet.Cells(Rows.Count, 2).End(xlUp).Row

Dadurch wird die letzte beschriebene Zeile in der Spalte B ermittelt.

Gruß

M.O.
0 Punkte
Beantwortet 18, Jul 2017 von Makroschnacker
Sehr gut. Funktioniert alles! Vielen Dank!

Gruß Mr. M.
...