eine tabelle kopieren und einige spalte löschen

Hallo zusammen,
ich habe ein Problem und möchte mit VBA lösen.
Diese Aufgabe ist ein bisschen wie was Franz gelöst hatte(meine Vorletzte Beitrag), aber einige Anpassung
Ich hole mir die Daten aus einem Ordner ab. die Daten sieht aus wie aus Tabelle1 ich habe nur geschrieben damit sie es sieht.
1. Nachdem ich die Daten geholt habe kopiere ich im neue tabelle die ich erzeuge habe (Tabelle2)im Tabelle2 und lösche Vorname und str.
2. ich schreibe mir eine neue Spalte mit name zeichnung die mit folgenden Kriterium ausgefüllt werden soll: wenn spalte nr die 5. Zahle "4" hat dann bitte "yes" wenn "7" bitte "no"
3. Dann erzeuge ich eine neue Tabelle3 und kopiere drin wenn die Spalte unter "1T" oder "8Z" hat, bitte ganze zeile kopieren und in neue Tabelle3 einfugen
4. am ende der Tabelle3 erzeuge ich eine neue tabelle wie im excel.
5.Dann erzeuge ich neue Tabelle4 und kopiere drin wenn die Spalte unter "5G" oder "3K" hat, bitte ganze zeile kopieren
bitte kann jemand mir helfen?
Ich bedanke mich
https://www.herber.de/bbs/user/114850.xlsm
Gruß
richar

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Richar
Der Code befindet sich in dem Excel Sheet welches ich hier auch nochmal verlinkt habe:
https://www.herber.de/bbs/user/114867.xlsm
Du musst nur das Sheet öffnen mit Alt+F11 kommst du in den VBA Editor und in Tabelle 2 findet du diesen Code:

Private Sub CommandButton1_Click()
Dim i As Integer
Dim k As Integer
Dim y As Integer
Dim letzteZeile As Integer
letzteZeile = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To letzteZeile
y = 0
If Cells(x, 2) = "1T" Then
y = Worksheets("Tabelle3").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle2").Range("A" & x & ":F" & x).Copy Destination:=Worksheets("Tabelle3"). _
Range("A" & y & ":F" & y)
Else
If Cells(x, 2) = "8Z" Then
y = Worksheets("Tabelle3").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle2").Range("A" & x & ":F" & x).Copy Destination:=Worksheets("Tabelle3"). _
Range("A" & y & ":F" & y)
Else
If Cells(x, 2) = "5G" Then
y = Worksheets("Tabelle4").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle2").Range("A" & x & ":F" & x).Copy Destination:=Worksheets("Tabelle4"). _
Range("A" & y & ":F" & y)
Else
If Cells(x, 2) = "3K" Then
y = Worksheets("Tabelle4").Range("A65536").End(xlUp).Row
y = y + 1
Worksheets("Tabelle2").Range("A" & x & ":F" & x).Copy Destination:=Worksheets("Tabelle4"). _
Range("A" & y & ":F" & y)
End If
End If
End If
End If
Next
End Sub

Du kannst in dem Sheet auf Tabelle 2 den Command Button 1 drücken und dann siehst auf Tabelle 3 und 4 das Ergebnis deiner gewünschten Auswertung. Das kannst du dann auch wieder löschen und wenn du nochmal auf den Button drückst füllt es wieder die Tabellen.
Gruss
Gunter

Beliebteste Forumthreads (12 Monate)

eine tabelle kopieren und einige spalte löschen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

eine tabelle kopieren und einige spalte löschen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread