Anpassung Tabellenblatt

Hallo!
Da ich gerade erst anfange, mich in VBA einzulesen, könnte ich ein wenig Hilfe gebrauchen. Da die Daten in dem Tabellenblatt vertraulich sind, kann ich das jetzt nicht einfach hier einfügen, sondern versuche es erstmal zu beschreiben.
Ich möchte gerne eine Kopie eines bestehenden Tabellenblattes auf ein neues Tabellenblatt - allerdings mit angepassten Werten der vorigen Tabelle.
Wenn bspw. "nicht erforderlich" steht, soll das Feld leer werden.
Wenn ein Datum kommt, soll daraus, je nach Spalte, ein bestimmter Wortlaut kommen.
Ganz wichtig ist aber: Wenn in einer Zeile NUR "nicht erforderlich" bzw. " " steht (also KEINE Zelle darf ein Datum o.ä. beinhalten), soll diese Zeile komplett gelöscht werden.
Das Ergebnis wäre also eine ausgedünnte neue Tabelle der Originaltabelle.
Ohne jetzt die Struktur der Tabelle zu kennen, wäre ich euch sehr dankbar, vielleicht ein paar Codeschnipsel zu bekommen, mit denen ich das umsetzen kann!
Viele Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Schaltfläche1_Klicken() Dim i As Long, raWeg As Range Application.ScreenUpdating = False Worksheets("Tabelle1").Range("A1").CurrentRegion.Copy _ Worksheets("Tabelle2").Range("A1") With Worksheets("Tabelle2") .Columns("A:K").AutoFit .Columns("C:K").Replace "nicht erforderlich", "" For i = 2 To .UsedRange.SpecialCells(xlCellTypeLastCell).Row If WorksheetFunction.CountA(.Range(.Cells(i, "C"), .Cells(i, "K"))) = 0 Then If raWeg Is Nothing Then Set raWeg = .Cells(i, "A").Resize(, 11) Else Set raWeg = Union(raWeg, .Cells(i, "A").Resize(, 11)) End If End If Next i If Not raWeg Is Nothing Then raWeg.Delete End If End With Set raWeg = Nothing End Sub

Hallo,
so:

Option Explicit
Sub Schaltfläche1_Klicken()
Dim i As Long, z As Long, raWeg As Range
Application.ScreenUpdating = False
Worksheets("Tabelle1").Range("A1").CurrentRegion.Copy _
Worksheets("Tabelle2").Range("A1")
With Worksheets("Tabelle2")
.Columns("A:K").AutoFit
.Columns("C:K").Replace "nicht erforderlich", ""
For i = 2 To .UsedRange.SpecialCells(xlCellTypeLastCell).Row
If WorksheetFunction.CountA(.Range(.Cells(i, "C"), .Cells(i, "K"))) = 0 Then
If raWeg Is Nothing Then
Set raWeg = .Cells(i, "A").Resize(, 11)
Else
Set raWeg = Union(raWeg, .Cells(i, "A").Resize(, 11))
End If
End If
Next i
If Not raWeg Is Nothing Then
raWeg.Delete
End If
For i = 3 To 11
For z = 2 To .Columns(i).Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, _
searchdirection:=xlPrevious).Row
If IsDate(.Cells(z, i)) Then .Cells(z, i) = .Cells(1, i) & "-Angabot"
Next z
Next i
End With
Set raWeg = Nothing
End Sub

Gruß Werner

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread