VBA wenn Bedingung erfüllt, dann in nächste Zeile schreiben
#1
Hallo,

vorab: Ich habe bereits in einem anderem Forum diese Frage gestellt.
http://www.office-loesung.de/p/viewtopic.php?f=166&t=793023


Hier noch einmal kurz eine Zusammenfassung. Mein Code erstellt eine neues Tabellenblatt mit einem definierten Namen in Abhängigkeit zu einer Zelle. Danach wird in dem neuen Tabellenblatt in die erste Zeile Spalte A eine Artikelnummer geschrieben und in Spalte B die Menge.

Nun kann es sein, dass es den Tabellennamen bereits gibt und kein zusätzliches Blatt erstellt werden soll, sondern zu dem bereits bestehendem Blatt hinzugefügt werden soll.

Sprich ich benötige eine IF oder Selectcase Schleife.
In diversen anderen Beiträgen und über Google, habe ich mal versucht mir eine If Funktion zu basteln.


Sub Bestelldatei()
    Dim i As Integer
        For i = 1 To Worksheets.Count
        If Worksheets(i).Name = Worksheets("Bestand").Range("E4") Then
'Wert aus Worksheets("Bestand".Range("B2") & F3in nächste Zeile eintragen
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 1).Value = Sheets("Bestand").Range("B1").Value
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Resize(1, 1).Value = Sheets("Bestand").Range("F3").Value
    
End If
Next
'Ein Tabellenblatt aktivieren'
Worksheets("Bestand").Activate
'Ein Tabellenblatt hinzufügen'
Worksheets.Add
'Ein Tabellenblatt umbennen'
ActiveSheet.Name = Worksheets("Bestand").Range("E4")

'Zelleninhalt aus B2 in neues Tabellenblatt A1 kopieren'
Worksheets("Bestand").Range("B2").Copy Destination:=ActiveSheet.Range("A1")
'Zelleninhalt aus F3 in neues Tabellenblatt B1 kopieren'
Worksheets("Bestand").Range("F3").Copy Destination:=ActiveSheet.Range("B1")
'Tabellenblatt verschieben'
      ActiveSheet.Select
    ActiveSheet.Move After:=Sheets(3)
   
    
End Sub



Es ist so, dass wenn kein Tabellenblatt mit dem Namen vorhanden ist, der zweite Teil funktioniert.
Wenn allerdings bereits ein Tabellenblatt vorhanden ist, bekomme ich nicht die Werte so übertragen wie ich möchte in die zweite Zeile. Es wird lediglich der Wert aus F3 an der richtigen Stelle hingeschrieben

Über Hilfe wäre ich sehr dankbar
Top
#2
Hallo,

teste:

Code:
Option Explicit

Sub Bestelldatei()
Dim i As Long, boVorhanden As Boolean

Application.ScreenUpdating = False

For i = 1 To Worksheets.Count
    If Worksheets(i).Name = Worksheets("Bestand").Range("E4") Then
       boVorhanden = True
       Exit For
       With Worksheets(i)
           .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Bestand").Range("B1").Value
           .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 1).Value = Sheets("Bestand").Range("F3").Value
       End With
   End If
Next i

If Not boVorhanden Then
   Worksheets.Add after:=Sheets(3)
   ActiveSheet.Name = Worksheets("Bestand").Range("E4")
   ActiveSheet.Range("A1") = Worksheets("Bestand").Range("B2")
   ActiveSheet.Range("B1") = Worksheets("Bestand").Range("F3")
End If
   
End Sub

Gruß Werner
Top
#3
Hallo Werner,

danke dir für deine Hilfe. Leider bekomme ich die Fehlermeldung Code kann nicht im Haltemodus durchgeführt werden. Zudem wird kein zusätzlicher Wert hinzugefügt, wenn ich eine andere Artikelnummer oder Menge hinzufüge.
Top
#4
Hallo,

ich hab mich an dem orientiert, was du als Code vorgegeben hattest.
Ich habe es jetzt mal angepasst, so wie ich denke, dass du dir das vorstellst.

Code:
Option Explicit

Sub Bestelldatei()
Dim i As Long, boVorhanden As Boolean

Application.ScreenUpdating = False

For i = 1 To Worksheets.Count
   If Worksheets(i).Name = Worksheets("Bestand").Range("E4") Then
      boVorhanden = True
      With Worksheets(i)
          .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Sheets("Bestand").Range("B1").Value
          .Cells(.Rows.Count, 1).End(xlUp).Offset(, 1).Value = Sheets("Bestand").Range("F3").Value
      End With
      Exit For
  End If
Next i

If Not boVorhanden Then
  Worksheets.Add after:=Sheets(3)
  ActiveSheet.Name = Worksheets("Bestand").Range("E4")
  ActiveSheet.Range("A1") = Worksheets("Bestand").Range("B1")
  ActiveSheet.Range("B1") = Worksheets("Bestand").Range("F3")
End If
 
End Sub
Und das mit dem Haltemodus: offensichtlich hast du im Code einen Haltepunkt gesetzt (brauner Punkt vor einer Codezeile). Mach den mal wieder raus.

Gruß Werner
Top
#5
Hallo Werner,

danke dir.
Ich habe den Code noch abgewandelt und eine Message Box hinzugefügt.
Ansonsten freue ich mich sehr, dass du dir die Zeit genommen hast.

Viele Grüße
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste