|  
                                             
	zählt eben nicht mit den Fingern, sondern benutzt den Kopf (von  Excel) 
	dieser Code ersetzt deinen Code, die Kommentare kannst du ja später löschen 
	und Alternativen sind gekennzeichnet 
	Zeitproblem - das Kommando Format liefert eine Zeichenkette, wozu also nochmals konvertieren, 
	prüfe lieber deine Excel - (Länder) u.a. Voreinstellungen 
	Zum Rest vom Fest gibt es auch Handbücher 
	  
	und Tschüss 
	  
Option Explicit
'Button ruft diese Prozedur
Private Sub NewEntry_Click()
'Festlegung der obersten Zeile
Const cOBERSTE As Long = 3          'hier die Zahl 3, sonst ändern
'als Bezug gilt : in der Tabelle Log-Data die Zelle Zeile cOberste Spalte 1
'der Bezug ist  : immer durch den Punkt vor der Anweisung im Code gegeben
With Sheets("Log-Data").Cells(cOBERSTE, 1)
   'ist die oberste Zeile leer? - prüfe die Zeile der bezogenen Zelle
   If Application.CountA(.EntireRow) = 0 Then
      'ist leer, dann ein erster Eintrag
      'die bezogene Zelle von Spalte 1 bis Spalte 17 erweitern und
      'mit dem Ergebnis(sen) der Funktion Eingabe füllen
      'die Funktion Eingabe dabei mit der 1 versorgen
      .Resize(1, 17).Value = Eingaben(1)
   Else
      'ist NICHT leer, dann ein erst die Zeile der bezogenen Zelle nach unten schieben
      .EntireRow.Insert shift:=xlDown
      'sind die Zeilen über der bezogenen Zelle leer, dann ginge auch der nächste Befehl
      '(auskommentiert)
      '.CurrentRegion.Cut .Offset(1)
      '
      'JETZT muss der Bezug neu verknüpft werden, der alte ist ja gewandert
      With Sheets("Log-Data").Cells(cOBERSTE, 1)
      'und wieder
      'die bezogene Zelle von Spalte 1 bis Spalte 17 erweitern und
      'mit dem Ergebnis(sen) der Funktion Eingabe füllen
      'die Funktion Eingabe dabei mit dem Wert der darunterliegeneden Zelle versorgen (alter Bezug)
      .Resize(1, 17).Value = Eingaben(.Offset(1).Value + 1)
      End With
   End If
End With
End Sub
Private Function Eingaben(Zahl) As Variant
'erfüllt die Funktion der Datensammlung und Benutzereingaben
'erhält für den ersten Wert "Zahl" übergeben
'ein Datenfeld genau so hoch und breit wie der Zellbereich
'eine Zeile und 17 Spalten
Dim Arr(1 To 1, 1 To 17) As Variant
   'die Werte sofort direkt versorgen oder abfragen
   Arr(1, 1) = Zahl
   Arr(1, 2) = Format(Now, "dd.mm.yy")
   Arr(1, 3) = Format(Now, "hh:nn:ss")
   Arr(1, 4) = Worksheets("Log-Entry").Cells(7, 4)
   Arr(1, 5) = Worksheets("Log-Entry").Cells(8, 4)
   Arr(1, 6) = Worksheets("Log-Entry").Cells(6, 4)
   Arr(1, 7) = InputBox("Used Frequency in MHz like 145000,00")
   Arr(1, 8) = InputBox("Used Frequency Band in m like 2m")
   Arr(1, 9) = InputBox("Used Mode like FM, DMR...")
   
   'hier für die spätere Spalte 10 gleich voreinstellen
   Arr(1, 10) = "none"
   'und nur wenn
   If InStr("FMDMR", UCase(Arr(1, 9))) > 0 Then _
   Arr(1, 10) = InputBox("Eventually used Relais in FM or DMR...")
   'der Unterstrich _ verkettet, daher kein End If
   '
   Arr(1, 11) = InputBox("Received Signal Level")
   Arr(1, 12) = InputBox("Transmitted Signal Level")
   Arr(1, 13) = InputBox("Callsign of OM/YL")
   
   'ditto
   Arr(1, 14) = "none"
   'achte auf die Groß-/Kleinschreibung
   If UCase(Arr(1, 9)) = "DMR" Then _
      Arr(1, 14) = InputBox("DMR-ID of OM/YL")
   'ggf.
   If InStr("FMDMR", UCase(Arr(1, 9))) > 0 Then Arr(1, 9) = UCase(Arr(1, 9))
   '
   Arr(1, 15) = InputBox("Country of OM/YL")
   Arr(1, 16) = InputBox("Quality of QSO")
   Arr(1, 17) = InputBox("Eventually Notes to the QSO")
   
   'das gefüllte Datenfeld an die Funktion, die übergibt an die einzelnen Zellen
   Eingaben = Arr
   
End Function
	  
     |