|
Hallo Liebe Community,
In meiner Subroutine soll das Programm bestimmte Werte in der Tabelle finden und die Nummer der ersten und letzten Zeile in der die Werte hinterlegt sind in einer Variable speichern. Vorher wird noch einer neue Tabelle angelegt. Diese soll dann mit Daten aus der aktuellen Tabelle befüllt werden. Das ist erst ein Teil des Codes.
Ich bekomme ständig die Fehlermeldung Objekt benötigt ausgegeben. Im Debugmodus ist die Zeile mit dem Instr Befehl gelb markiert. Ich kann den Fehler absolut nicht finden. Danke im Vorraus für euer Hilfe.
Dim BereichA As Integer
Dim BereichE As Integer
Dim Spalte As Integer
Dim Filiale As String
Dim Name1 As String
Sub NeueArbeitsmappe()
Dim Name2 As String
Dim Datum As Date
Dim Bestellnr As String
Name1 = ActiveWorkbook.Name
Workbooks.Add
Name2 = ActiveWorkbook.Name
Windows(Name2).Activate
ActiveCell.FormulaR1C1 = "Datum"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Bestellung"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Filiale Nr."
Range("D1").Select
ActiveCell.FormulaR1C1 = "Artikel"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Text"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Artikelnummer DTV"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Menge"
Range("H1").Select
ActiveCell.FormulaR1C1 = "ME"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Netto"
Windows(Name1).Activate
Range("G4").Select
Datum = ActiveCell.Value
Windows(Name2).Activate
Range("A2").Select
ActiveCell.Value = Datum
Windows(Name1).Activate
Range("D4").Select
Bestellnr = ActiveCell.Value
Windows(Name2).Activate
Range("B2").Select
ActiveCell.Value = Bestellnr
Spalte = 1
Filiale = 2
Call BB
MsgBox BereichA & BereichE
Columns("A:I").EntireColumn.AutoFit
End Sub
Sub BB()
Dim i As Integer
Dim SearchStr As String
Dim Zeile As Integer
Dim TextPos As Integer
i = 0
Zeile = 6
Windows(Name1).Activate
Do While i = 0
SearchStr = Cells(Zeile, Spalte).Value
TextPos = InStr(1, SearchStr, Filiale, CompareMethod.Text)
If TextPos = 1 And Cells(Zeile + 1, Spalte) <> "" Then
BereichA = Zeile
Zeile = Zeile + 1
ElseIf TextPos = 1 And Cells(Zeile + 1, Spalte) = "" Then
BereichE = Zeile
i = 1
Else
Zeile = Zeile + 1
End If
Loop
End Sub
Gruß Gregor |