|
Hallo Leute,
ich habe da ein kleines "Range" Problem. Ich suche nach einem Wort, wenn gefunden dann füge darunter eine Zeile ein danach schreibe in die erste Spalte einen Text
und danach färbe Spalte A und B mit einer Farbe ein. Soweit so gut. Mein Problem bei der Sache ist nun, dass er alle Spalten einfärbt und ich weiß nicht wo in
meinem Code ich das einfügen müss.
Kann mir wer helfen??
Hier der Code:
Sub Angebot()
'Zellen nach Spalte 1 sortieren
Dim Bereich As Range
Dim A2 As String
Dim A3 As String
Dim Wort, FiAd As Range
Application.ScreenUpdating = False
A2 = Cells(2, 1).Value
Range("A2") = "1_" & A2
Range("A3") = "1_Z"
Set Bereich = ActiveSheet.UsedRange
Set Bereich = Range("A4", Bereich(Bereich.Cells.Count))
Bereich.sort Key1:=Bereich(1), Order1:=xlAscending, Key2:=Bereich(4) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Range("A2") = A2
Range("A3") = ""
'Suche nach dem Wort Netzanschluß, wenn gefunden füge Unterhalb eine neue Zeile ein
Set Bereich = Range("AA3:AL3")
Set Wort = Range("A2:A50000").Find("Netzanschluß", , xlValues, xlWhole, , xlPrevious)
If Not Wort Is Nothing Then
Rows(Wort.Row + 1).Insert
Bereich.Copy (Cells(Wort.Row + 1, 1))
Rows(Wort.Row + 1).Select
ActiveCell.FormulaR1C1 = "Zz Lohnanteil Abschnitt" 'schreibe den Text in die neu eingefügte Zelle
End If
'Formatiere die Schriftart bzw. Schriftgröße
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
'Formatiere die Ausrichtung des Textes
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Fülle die Spalte 1(A) und 2(B) mit der Farbe (Spalte 1 und 2 da ich mit Z1S1-Bezugsart arbeite)
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16777164
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("E:E").Select
Selection.TextToColumns Destination:=Range( _
"Tabelle2[[#Headers],[Herstellerbezeichnung]]"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Application.ScreenUpdating = True
End With
End Sub
|