Hallo liebes Forum,
ich versuche die VBA's meist selbst zu erarbeiten bzw. durch suche zu finden.
Leider hab ich hier einen Punkt an dem ich absolout nicht weiterkomme.
Also ich habe ein Tabellenblatt mit bis zu 30000 Zeilen.
In Schritt 1 bereinige ich mit dem Autofilter das Tabellenblatt um alle Zeilen die ich nicht benötige.
Rows("1:1").Select
Selection.ClearContents
Selection.AutoFilter
ActiveSheet.Range("$A$1:$BH$4343").AutoFilter Field:=1, Criteria1:="=S300" _
, Operator:=xlOr, Criteria2:="=S400"
Rows("1:5074").Select
Selection.Delete Shift:=xlUp
In Schritt 2 erstelle ich ein neues Tabellenblatt
Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Ergebnis"
Aus dieser nun bereinigten Tabelle benötige ich ledigliche einzelne Zellen die aber hier leider total durcheinander in den Zeilen 1 - 4 stecken.
Dafür würde ich gerne die Zellen die ich benötige in eine Zeile in dem neuen Tabellenblatt schreiben.
Dafür habe ich auch einen Code gefunden der funktionieren würde.
Er kopiert die beliebigen Zellen und schreibt diese in die jeweils nächste leere Zeile im neuen Tabbelenblatt in eine Zeile.
Ich möchte diese wild durcheinander liegenden Zellen einfach nur in eine Zeile schreiben damit es übersichtlicher wird.
Zeile 1 - 4 sind jeweils eine Zeile im neuen Tabellenblatt.
Was ich leider nicht umsetzen konnte ist nun das der VBA die bereits kopierten Zeilen 1 - 4 löscht und den Kopiervorgang + löschen so lange wiederholt bis´keine Zeilen mehr im ersten Tabellenblatt mehr vorhanden sind.
könnte mir da jemand helfen ?
Dim letzteZeile As Integer
letzteZeile = Sheets("Ergebnis").Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.Range("I1").Copy
Sheets("Ergebnis").Range("A" & letzteZeile).PasteSpecial Paste:=xlValues
ActiveSheet.Range("C1").Copy
Sheets("Ergebnis").Range("B" & letzteZeile).PasteSpecial Paste:=xlValues
ActiveSheet.Range("G1").Copy
Sheets("Ergebnis").Range("C" & letzteZeile).PasteSpecial Paste:=xlValues
ActiveSheet.Range("I3").Copy
Sheets("Ergebnis").Range("D" & letzteZeile).PasteSpecial Paste:=xlValues
ActiveSheet.Range("I4").Copy
Sheets("Ergebnis").Range("E" & letzteZeile).PasteSpecial Paste:=xlValues
ActiveSheet.Range("F1").Copy
Sheets("Ergebnis").Range("F" & letzteZeile).PasteSpecial Paste:=xlValues
ActiveSheet.Range("K1").Copy
Sheets("Ergebnis").Range("G" & letzteZeile).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False