Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Hallo VBA-Experten

ich versuche mal mein Glück bei Euch

Ich arbeite seit langem an einer Datei mit drei Arbeitsblättern und in jedem Arbeitsblatt befindet sich eine Tabelle und ich habe verschiedene Codes geschrieben, die auch funktionieren, wie ich es möchte. Leider heißt es nun, dass die Tabellen neue Spalten in der Zukunft bekommen könnten und da liegt mein Problem. Die Codes, die ich geschrieben habe, beziehen sich auf bestimmte Spalten oder Ranges der Tabellen. D.h. wenn man neue Spalten in die Tabellen hinzufügen würde, würden meine Codes sehr wahrscheinlich nicht mehr funktionieren.

Ich habe bei verschiedenen Forums gelesen, dass man die Spalten/Ranges benennen kann und so würden neue Spalten meinen Code nicht kaputt machen. Leider blicke ich nicht mehr durch und die Umsetzung funktioniert irgendwie nicht. Die Datei darf ich allerdings nicht hochladen.

Die Frage an Euch wäre: Wie könnte ich folgende Teile meiner Codes (rot markiert) umbenennen, damit meine Codes weiter funktionieren, wenn es neue Spalten gäbe? Hier sind meine Codes natürlich nicht komplett geschrieben. Die Teile habe ich aus den Codes rauskopiert. Ich wäre sehr dankbar für jede Hilfe oder Idee! 

Beim ersten Code:

With wsfirsttable
        Set rngolddata = .Range("A4:I" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

 With wssecondtable
        Set rngnewdata = .Range("A4:I" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

 With wsfirsttable.Sort
        .SortFields.Clear
        .SortFields.Add Key:=wsfirsttable.Range("A4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rngolddata
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Dim columns
columns = Array("B", "C", "D", "E", "F", "G", "H", "I")
For j = 1 To 8
n = j + 1
vout = CStr(n)

    rngnewdata.Offset(1, rngnewdata.columns.Count + j).Resize(rngnewdata.Rows.Count - 1, 1).FormulaLocal = _
        "=WENN($J5<>0;" + columns(j - 1) + "5=SVERWEIS(A5;" & wsfirsttable.Name & "!" & rngolddata.Address & ";" + vout + ";WAHR);"""")"

Next j


wssecondtable.AutoFilter = False

    With rngnewdata
   
    For x = 11 To 18
    n = x - 9
        .AutoFilter field:=x, Criteria1:="FALSCH"
        For Each rnghit In .Offset(1, 0).Resize(.Rows.Count - 1, .columns.Count).SpecialCells(xlCellTypeVisible)
            If rnghit.Column = n Then rnghit.Interior.Color = vbRed
        Next rnghit
    Next x
    End With

wssecondtable.AutoFilterMode = False
    With rngnewdata
        .AutoFilter field:=10, Criteria1:="0"                                         
        For Each rnghit In .Offset(1, 0).Resize(.Rows.Count - 1, .columns.Count).SpecialCells(xlCellTypeVisible)
            If rnghit.Column < 10 Then rnghit.Interior.Color = vbRed
        Next
    End With

 With wssecondtable
        .AutoFilterMode = False
        For i = 10 To 18
            .columns(i).ClearContents
        Next i
    End With

Beim zweiten Code:

 With wsfirsttable
        Set rngolddata = .Range("A4:I" & .Cells(.Rows.Count, 1).End(xlUp).Row)                 
        Set rngnewdata = .Range("J5:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)                 
        Set x = .Range(Cells(R, 1), Cells(R, 16))
     End With

 
For R = 5 To 1000

  Blue = RGB(188, 255, 255)

   V = Cells(R, 4).Value
   
  If InStr(V, "Closed") Then
    x.Interior.Color = RGB(194, 194, 194)
   
    ElseIf InStr(V, "progress") > 0  Or InStr(V, "approval") > 0 _
                Or InStr(V, "Fulfillment") > 0  Or InStr(V, "Open") > 0 Then
                    x.Interior.Color = Blue
  End If

With Sheets("firsttable").Range("A5:P" & lRow).Borders           
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
 End With

 For Row = MaxRow To 5 Step -1
        If .Cells(Row, 4).Value = "Closed" And CurrentDate1 > .Cells(Row, 6).Value Then
        .Rows(Row).Delete
        ElseIf .Cells(Row, 1).Value = "" Then
        .Rows(Row).Delete
        n = n + 1
        End If
    Next Row


Beim dritten Code:

With wsthirdtable
    Set rngolddata = .Range("J5:P" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    rngolddata.Select
    Selection.NumberFormat = "0"
End With


Ich bedanke mich schon im Voraus!