Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Kopieren von best. Zellen in anderes Blatt

VBA: Kopieren von best. Zellen in anderes Blatt
08.03.2019 11:34:45
best.
Hallo zusammen,
ich würde gerne aus einem Tabellenblatt bestimmte Zellen in ein zweites Tabellenblatt kopieren.
Es soll Spalte B, C und D kopiert werden, wenn in Spalte E ein "x" steht. Der Bereich in dem sich die Werte befinden, ist A34:E120.
In Tabelle 2 sollen die Werte ab Zeile 16 in die Spalten B, C und D eingefügt werden. In Spalte A sollen Positionen gesetzt werden, je nach Anzahl der Zellen in Tabelle 1, die ein x enthalten.
Aus einem anderen Makro habe ich folgenden Code, jedoch bekomme ich es nicht hin diesen so umzuschreiben, dass es in meinem Fall funktioniert:
Dim TB1, TB1Z1 As Integer, LR1 As Integer, SP As Integer, RNG As Range
Dim TB2, TB2Z1 As Integer, LR2 As Integer
Set TB1 = Sheets("Tabelle 1")
Set TB2 = Sheets("Tabelle 2")
Set RNG = TB1.Columns("B") 'Bereich, der übertragen werden soll
TB1Z1 = 35 'erste Zeile mit Daten
TB2Z1 = 17 'erste Zielzeile
SP = 3 'Spalte mit Mengenangaben "C"
LR1 = TB1.Cells(TB1.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte
With TB1.Cells(TB1Z1, SP).Resize(LR1 - TB1Z1 + 1, 1)
'Prüfen ob Mengen eingetragen wurden
If WorksheetFunction.Sum(.Cells) > 0 Then
'Reset Zieltabelle
LR2 = TB2.Cells(TB2.Rows.Count, "C").End(xlUp).Row 'Letzte Zeile
TB2.Cells(TB2Z1, 1).EntireRow.ClearContents 'erste zeile leeren
TB2.Cells(TB2Z1 + 1, 1).Resize(LR2, 1).EntireRow.Delete xlUp 'Rest löschen
'Nur Zeilen mit Menge übertragen
Intersect(RNG, .SpecialCells(xlCellTypeConstants, 3).EntireRow).Copy TB2.Cells(TB2Z1, 2)
'Positionen setzen
LR2 = TB2.Cells(TB2.Rows.Count, "C").End(xlUp).Row 'Letzte Zeile
With TB2.Cells(TB2Z1, 1).Resize(LR2 - TB2Z1 + 1, 1)
.FormulaR1C1 = "=ROW(R[-2]C)"
.Value = .Value
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders(xlEdgeBottom).Weight = xlMedium
End With
'Format aus Zeile 3 übertragen
TB2.Cells(TB2Z1, 1).EntireRow.Copy
TB2.Cells(TB2Z1, 1).Resize(LR2 - TB2Z1 + 1, 1).EntireRow.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub
Falls ich etwas vergessen habe, lasst mich es einfach wissen.
Vielen Dank für eure Hilfe.
Beste Grüße
Chris

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Kopieren von best. Zellen in anderes Blatt
09.03.2019 15:09:25
best.
Hallo Chris,
in Deinem Code gibt es kein For und auch keinen Autofilter.
Die meisten bauen Deine Datei nicht nach. Die Zeit hat schon jemand investiert.
Ein Nachbau sieht meist anders aus als das Original. Darum sollte das Original verlinkt werden.
Die meisten möchten es am Original testen um den gleichen Fehler zu erhalten.
Benutze hier im Forum die Funktion zum hochladen. Falls Du die nicht benutzen möchtest beachte, von unsicheren Servern wie z.B. www.file-upload.net lade ich keine Datei runter. (lt. Einschätzung meines Virenprogramms)

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
Anzeige

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige