Super!!!!!!!!!!!!!!!! :23:
Jetzt kann ich es halbwegs nachvollziehen.
Ist es noch möglich in Tabelle1 die Zellen Rot zu markieren die es nicht gefunden hat?
Hallo,
Stefans Code so erweitert müsste Deinem Wunsch entsprechen:
Code:
Sub prcKopieren()
Dim lngC As Long, lngZ As Long
Dim rngSuche As Range
Application.ScreenUpdating = False 'Bidschirmaktuallisierung aus
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte belgte Zeile in Spalte A
.Range("A3:A" & lngZ).Interior.ColorIndex = xlNone 'A3:A bis letzte belegte Zeile Farben raus
'eine Schleife durch die Spalte A der Tabelle1 bis zum Ende
For lngC = 3 To lngZ
If InStr(.Cells(lngC, 1), "Überschrift") = 0 Then 'wenn Zelle nicht "Überschrift"
'der Wert aus der Zelle A... wird in der Tabelle Rohdaten gesucht
Set rngSuche = Worksheets("Rohdaten").Columns(1).Find(.Cells(lngC, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
'wenn der Wert in der Tabelle Rohdaten gefunden wird
If Not rngSuche Is Nothing Then
.Cells(lngC, 1).Interior.ColorIndex = 3 'Zelle Rot
'wird die Zeile aus der Tabelle Rohdaten kopiert
rngSuche.Offset(, 6).Resize(, 10).Copy
'und in der Tabelle1 eingefügt
.Cells(lngC, 7).PasteSpecial xlValues
End If
End If
Next lngC
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True 'Bidschirmaktuallisierung ein
End Sub
fast, mit deinem Code werden die gefundenen Rot markiert, was aber bei den nicht gefundenen sein sollte
Hallo,
dann so:
Code:
Sub prcKopieren()
Dim lngC As Long, lngZ As Long
Dim rngSuche As Range
Application.ScreenUpdating = False 'Bidschirmaktuallisierung aus
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte belgte Zeile in Spalte A
'eine Schleife durch die Spalte A der Tabelle1 bis zum Ende
For lngC = 3 To lngZ
If InStr(.Cells(lngC, 1), "Überschrift") = 0 Then 'wenn Zelle nicht "Überschrift"
'der Wert aus der Zelle A... wird in der Tabelle Rohdaten gesucht
Set rngSuche = Worksheets("Rohdaten").Columns(1).Find(.Cells(lngC, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
'wenn der Wert in der Tabelle Rohdaten gefunden wird
If Not rngSuche Is Nothing Then
.Cells(lngC, 1).Interior.ColorIndex = xlNone 'wenn gefunden dann Zellfarbe raus
'wird die Zeile aus der Tabelle Rohdaten kopiert
rngSuche.Offset(, 6).Resize(, 10).Copy
'und in der Tabelle1 eingefügt
.Cells(lngC, 7).PasteSpecial xlValues
Else
.Cells(lngC, 1).Interior.ColorIndex = 3 'Zelle Rot
End If
End If
Next lngC
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True 'Bidschirmaktuallisierung ein
End Sub
Die Zeilen mit Überschriften werden aussen vor gelassen.
Perfekt!!!!!!!!!!!!!!!!
vielen Dank an alle die mir geholfen haben :23:
Welche Voraussetzung muss die Zelle haben das sie als Überschrift erkannt wird?
Hallo,
das hat Atilla im Code eingebaut ansonsten würde ich dir mal diese
Seite empfehlen.
Hallo zusammen,
Stefan, da hab ich wohl zu oberflächlich gedacht.
In der Überschriftzelle wird wahrscheinlich etwas anderes stehen als "Überschrift.."
@JimmyJoe
Formatier die Überschriftzelle Fett, dann ersetze im Code diese Zeile:
Code:
If InStr(.Cells(lngC, 1), "Überschrift") = 0 Then 'wenn Zelle nicht "Überschrift"
mit dieser:
Code:
If .Cells(lngC, 1).Font.Bold = False Then 'wenn Zelle nicht Fett formatiert"