ich bin jetzt schon seit 4 Tagen eine Lösung für mein Problem am suchen...
Ich habe 2 Tabellen. Aus der Tabelle 2 meiner Arbeitsmappe werden die Werte der Spalten A und B dank Filterfunktion und Transponieren in die Zeile D17 und D18 kopiert. Das hab ich hinbekommen.
Jetzt habe ich in Spalte D19 eine Arrayformel eingefügt und lasse diese bis zum Ende von Spalte D, Solange in Spalte A ein Wert steht Einfügen. Das klappt auch
Aber jetzt kommt mein Problem ich möchte danke Autofill diese Formel auch bis zur letzten befüllten Spalte von D17 automatisch ausfüllen lassen.
Ich habe das Makro über den Makroeditor aufzeichnen lassen und wollte erst nach dem ich das Problem gelöst habe mein Makro bereinigen.
Icch habe alles soweit geschafft nur wie bekomme ich es halt hin das er den Bereich Spalte D19 bis D"letzte Zeile" bis in die letzte Spalte von Zeile 17 mit autofill füllt ohne einen Laufzeitfehler zu machen
Mein Problem fängt an ab der Zeile mit dem Dim...
Sub Raumstruktur()
' Raumstruktur Makro
' Raumstruktur
ActiveWorkbook.Sheets(2).Name = "Tabelle1"
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("A:C").Select
Selection.Copy Range("J1")
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[9]=""kein Raum"",""Aussenbereich"",RC[9])&"" ""&IF(RC[10]=""xxx"","" "",RC[10])" _
_
_
Range("A1").Select
Selection.AutoFill Destination:=Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp). _
_
_
Row), Type:=xlFillDefault
Range("B1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[10]=""xxx"","" "",RC[10])"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp). _
_
_
Row), Type:=xlFillDefault
Range("B1:B544").Select
Range("C1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[9]=""xxx"","" "",RC[9])"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp). _
_
_
Row), Type:=xlFillDefault
Range("C1:C544").Select
Range("H1").Select
Selection.FormulaArray = _
"=IF(MATCH(RC[-7]&RC[-6],R1C[-7]:R10000C[-7]&R1C[-6]:R10000C[-6],0)=ROW(),"""","" _
Duplikat"")"
Selection.AutoFill Destination:=Range("H1:H" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp). _
_
_
Row), Type:=xlFillDefault
Range("H1:H544").Select
Range("H1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$H$544").AutoFilter Field:=8, Criteria1:="="
Range("A1:B544").Select
Selection.Copy
Sheets("Aufmaßdaten").Select
Range("D17").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("Tabelle1").Select
Range("H1").Select
ActiveSheet.Range("$A$1:$H$544").AutoFilter Field:=8
Application.CutCopyMode = False
Selection.AutoFilter
Sheets("Aufmaßdaten").Select
Dim LSP As Long ' Ab hier ist mein Problem
With ActiveSheet
LSP = .Cells(17, Columns.Count).End(xlToLeft).Column
Range("D19").Select
Selection.FormulaArray = _
"=IF(ISNA(INDEX(Tabelle1!C6,MATCH(RC1&R17C&R18C,Tabelle1!C4&Tabelle1!C1&Tabelle1!C2,0))) _
_
_
,"""",INDEX(Tabelle1!C6,MATCH(RC1&R17C&R18C,Tabelle1!C4&Tabelle1!C1&Tabelle1!C2,0)))"
Selection.AutoFill Destination:=Range("D19:D" & ActiveSheet.Cells(Rows.Count, 1).End( _
xlUp).Row), Type:=xlFillDefault
Range("D19:D" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Select
Selection.AutoFill Destination:=Range("D19", cell(19, LSP:LSP & ActiveSheet.Cells(Rows. _
_
_
Count, 1).End(xlUp).Row), Type:=xlFillDefault
End With
'Selection.AutoFill Destination:=Range("D19":19 & ActiveSheet.Cells(17, Columns.Count).End( _
_
_
xlToLeft).Column)), Type:=xlFillDefault
'Selection.AutoFill Destination:=Range(Cells(19, 4), Cells(19, 256) & ActiveSheet.Cells(17, _
_
_
Columns.Count).End(xlToLeft).Column), Type:=xlFillDefault
'Range("D19:D" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Select
'Range("D19", "D" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)Selection.AutoFill _
Destination:=Range("D19","D" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row) & ActiveSheet. _
Cells(17, Columns.Count).End(xlToLeft).Column), Type:=xlFillDefault
'Range("D19:HL270").Select
End Sub
Ich habe dann alle meine Versuche die ich vorher gemacht habe einfach als Kommentar gekennzeichnet um darauf vielleicht doch zurückgreifen zu können.
Danke schon einmal für eure Hilfe :-)
Gruß
Georg