Office: Überschrift + Markierung?

Habe zwei Fragen:

Wie kann ich eine Markierung dauerhaft in meiner Kopfzeile machen, ohne das ich wenn ich meinen Commandbutton benutze diese verschwindet??

Bei meiner 2. Tabelle verschwindet wenn ich eine Suche mache, ohne die etwas gefunden wird die Kopfzeile... vll kann mir jemand sagen warum??

danke schon mal im voraus

das is mein Makro

Code:

Sub Maxdata() 
Dim rBereich As Range 
Dim rZelle As Range 
Dim wert As String 
Dim vUebArr() As Variant 
Dim iAnz As Integer 
Dim iSpalte As Integer 
Dim lZiel As Long 
Dim sBereich As String 
Worksheets("Suchergebnis").Range("a2:i65536").Clear 
wert = InputBox("Suchbegriff") 
ReDim vUebArr(Sheets("Systemscheine").Range("A65536").End(xlUp).Row, 8) 
Range("A1:IV" & Range("A65536").End(xlUp).Row).Interior.ColorIndex = xlNone 
With Sheets("Systemscheine").Range("A3:H" & Range("A65536").End(xlUp).Row) 
    Set c = .Find(wert, LookIn:=xlValues, LookAt:=xlPart) 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
            Rows(c.Row).Interior.ColorIndex = 27 
                    For iSpalte = 1 To 8 
                vUebArr(iAnz, iSpalte - 1) = Sheets("Systemscheine").Cells(c.Row, iSpalte).Value 
            Next iSpalte 
            iAnz = iAnz + 1 
            Set c = .FindNext(c) 
        Loop While Not c Is Nothing And c.Address <> firstAddress 
    End If 
End With 
lZiel = Sheets("Suchergebnis").Range("A65536").End(xlUp).Row 
iBereich = "2:" & lZiel 
With Sheets("Suchergebnis") 
    .Range("A2:H" & iAnz + 1) = vUebArr 
    .Columns("A:H").EntireColumn.AutoFit 
End With 
End Sub  

 

Wenn irgendwas an der Fragestellung nicht klar ist, dann schreibt es mir bitte :!: :!: :!: :!: :!: :!: :!: :!:

 

Hallo!

Ohne die Tabelle zu kennen, ist es schwierig...
Vielleicht reicht aber schon dies:

With Sheets("Suchergebnis")
.Range("A2:H" & iAnz + 2) = vUebArr
.Columns("A:H").EntireColumn.AutoFit
End With

 

mhm... also das hat sich geklärt, habe nur noch eine frage, ob das mit dem markieren funktioniert??
weil wenn ich jedesmal eine suche starte verschwindet die markierung wieder? ist es möglich das die markierung dauerhaft bleibt??

 

Durch diese Zeile werden alle Farben entfernt:

Range("A1:IV" & Range("A65536").End(xlUp).Row).Interior.ColorIndex = xlNone

Wenn du diese weglässt, bleiben die Markierungen.

 

Ups, ich habe mich dumm ausgedrückt (sry)
aber das is genau das was ich meinte dake schön^^

 

Eine Frage habe ich ncoh, den es hat nur halb geklappt (d.h. auf einem Tabellenblatt), was muss ich bei dem makro verändern, das auch beim 2. tabllenblatt sich die Farbe nicht verändert?? das tabellenblatt heißt suchergebnisse!

Code:

'Sub Neu()
'Dim rBereich As Range
'Dim rZelle As Range
'Dim wert As String
'Dim vUebArr() As Variant
'Dim iAnz As Integer
'Dim iSpalte As Integer
'Dim lZiel As Long
'Dim sBereich As String
'Dim vTitArr As Variant
'Dim c As Range
'Dim firstAddress As String
'vTitArr = Sheets("systemscheine").Range("A1:H1").Value
'wert = InputBox("Suchbegriff")
'ReDim vUebArr(Sheets("systemscheine").Range("A65536").End(xlUp).Row, 8)
'Sheets("systemscheine").Range("A1:IV" & Sheets("systemscheine").Range("A65536").End(xlUp).Row).Interior.ColorIndex = xlNone
'With Sheets("systemscheine").Range("A2:H" & Range("A65536").End(xlUp).Row)
'    Set c = .Find(wert, LookIn:=xlValues, LookAt:=xlPart)
'    If Not c Is Nothing Then
'        firstAddress = c.Address
'        Do
'            Rows(c.Row).Interior.ColorIndex = 6 ' 27
'                For iSpalte = 1 To 8
'                    vUebArr(iAnz, iSpalte - 1) = Sheets("systemscheine").Cells(c.Row, iSpalte).Value
'                 Next iSpalte
'            iAnz = iAnz + 1
'
'            Set c = .FindNext(c)
'        Loop While Not c Is Nothing And c.Address <> firstAddress
'    End If
'End With
'lZiel = Sheets("suchergebnis").Range("A65536").End(xlUp).Row
'iBereich = "2:" & lZiel
'With Sheets("suchergebnis")
'    .Rows(iBereich).Delete Shift:=xlUp
'    .Range("A2:H" & iAnz + 1) = vUebArr
'    .Range("A1:H1") = vTitArr
'    .Columns("A:F").EntireColumn.AutoFit
'End With
'End Sub
Sub Neu()
Dim rBereich As Range
Dim rZelle As Range
Dim wert As String
Dim vUebArr() As Variant
Dim iAnz As Integer
Dim iSpalte As Integer
Dim lZiel As Long
Dim sBereich As String
Dim vTitArr As Variant
vTitArr = Sheets("systemscheine").Range("A1:H1").Value
wert = InputBox("Suchbegriff")
ReDim vUebArr(Sheets("systemscheine").Range("A65536").End(xlUp).Row, 8)
Range("A2:IV" & Range("A65536").End(xlUp).Row).Interior.ColorIndex = xlNone
With Sheets("systemscheine").Range("A2:H" & Range("A65536").End(xlUp).Row)
    Set c = .Find(wert, LookIn:=xlValues, LookAt:=xlPart)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Rows(c.Row).Interior.ColorIndex = 27
                    For iSpalte = 1 To 8
                vUebArr(iAnz, iSpalte - 1) = Sheets("systemscheine").Cells(c.Row, iSpalte).Value
            Next iSpalte
            iAnz = iAnz + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
lZiel = Sheets("suchergebnis").Range("A65536").End(xlUp).Row
iBereich = "2:" & lZiel
With Sheets("suchergebnis")
    .Rows(iBereich).Delete Shift:=xlUp
    .Range("A2:H" & iAnz + 1) = vUebArr
    .Range("A1:H1") = vTitArr
    .Columns("A:F").EntireColumn.AutoFit
End With
End Sub

 

Ich kann nicht erkennen, dass dein Makro überhaupt auf die Farben des Blatts "suchergebnis" zugreift...

 

Ich glaube das is das Problem^^ habe probiert so eine markierung einzufügen, aber dann zeit mir VBA ein Fehler an =( ist es irgendwie möglich, dieses "zugreifen" in den Makro reinzuschreiben?????????

 

Ich habe es mir einfach gemacht, und einfach nen makro genommen der die erste reihe markiert^^ damit is das problem gelöst