Zellenformat auch kopieren
17.12.2015 07:54:34
Wolfgang
den nachfolgenden Code erhielt ich hier aus diesem Forum. Wie kann ich den Code anpassen, damit auch das Zellenformat aus der Zieltabelle übernommen wird. Konkret geht es mir darum, dass diverse Zeilen rot markiert sind, insbesondere dieses Format hätte ich gerne übernommen. Danke schon jetzt für die Rückmeldungen.
Gruß - Wolfgang
Private Sub cmdExtrahieren_Click()
Dim sh As Worksheet
Dim maxID As Integer, gZeile As Long, eZeile As Long, cnt As Long
Dim newErgebnis As Boolean
'Zeilen durchsuchen und in neuen Blatt einfügen
For gZeile = 2 To shGrunddaten.UsedRange.Row + shGrunddaten.UsedRange.Rows.Count - 1 ' _
Start-Zeile ggf. anpassen
If (shGrunddaten.Range("L" & gZeile).Text = ComboBox1.Text _
Or (shGrunddaten.Range("L" & gZeile).Text = "" And ComboBox1.Text = "(Leere)") _
_
Or (shGrunddaten.Range("L" & gZeile).Text "" And ComboBox1.Text = "(nicht _
Leere)") _
Or ComboBox1.Text = "(Alle)") _
And _
(ComboBox2.Text = "" Or shGrunddaten.Range("O" & gZeile).Text = ComboBox2. _
Text) _
And _
(ComboBox3.Text = "" Or shGrunddaten.Range("I" & gZeile).Text = ComboBox3. _
Text) _
And _
(ComboBox4.Text = "" Or shGrunddaten.Range("G" & gZeile).Text = ComboBox4. _
Text) Then
If Not newErgebnis Then
With shErgebnis
.Visible = xlSheetVisible
cnt = .UsedRange.Row + .UsedRange.Rows.Count - 1
eZeile = 2 '1. Zeile in die Daten kopiert werden sollen - _
ggf anpassen!!!!!
If cnt >= eZeile Then
' 'Altdaten im Ergebnisblatt löschen
.Range(.Rows(eZeile), .Rows(cnt)).Delete shift:=xlShiftUp
End If
End With
cnt = 0
newErgebnis = True
End If
shErgebnis.Rows(eZeile).Value = shGrunddaten.Rows(gZeile).Value
eZeile = eZeile + 1: cnt = cnt + 1
End If
Next gZeile
If cnt Then
shErgebnis.Activate
MsgBox "Es wurden " & cnt & " Datensätze nach '" & shErgebnis.Name & "' extrahiert!" _
, _
vbInformation, "Extrahieren"
Sheets("Start").Activate
Unload Me
Else
MsgBox "Es konnten keine entsprechenden Datensätze gefunden werden", vbInformation, _
_
"Extrahieren"
End If
End Sub