VBA für Dateneingabe

[Scolex2015]

Hi,

jetzt schreibe ich es doch:

wenn atilla sich Steffls Code vornimmt und eine Verbesserung einbaut, dann solltest Du nicht mit Steffls unverändertem Code weiterarbeiten, sondern atillas Code verwenden. Wenn Du den Code nicht verstehst, solltest Du bei ihm nachfragen.

Morgen, also vorweg nochmal großes Dankeschön für die große Anteilnahme...

...der Grund warum ich Atillas Code erstmal hinten in meiner Überlegung angestellt hatte war der, dass ich glaubte den Lösungsansatz in Steffl (Formelerhaltung) und Schauan (Tabellenübernahme) zu finden. Atillas Code sieht formtechnisch erstmal sehr gut aus überschreibt aber in der Tabelle die alten Datensätze. Aufgrund dessen versuche ich immernoch

Steffls Code mit Schauan seinen zu kombienieren. Wenn der Code steht kann man immernoch Schönheitskorrekturen vornehmen aber die Funktionalität geht mir erstmal vor. Was keinerlei undankbarkeit oder ignoranz geschuldet sein soll. Wir haben hier immernoch drei Top Codes die aber alle nicht komplett funktionieren und irgendwie zusammengepuzzeld werden wollen.

Steffl + Schauan: Bei der Verschmelzung hat Steffls Code die Eigenschaft verloren die Formeln zu erhalten.

Sub Dateneingabe()
 
 'Bildschirm höre auf zu zappeln!
 Application.ScreenUpdating = False
 
 'Bereich von bis wird kopiert
 Sheets("Eingabemaske").Range("A7:G7").Copy
 
'Wenn letzte Zeile des Tabellenbereiches nicht leer ist, dann
If Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).Value <> "" Then
'unter dem Bereich einfuegen
Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'ansonsten
Else
'nochmal nach oben und dann unter den Daten einfuegen
Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'Ende Wenn letzte Zeile des Tabellenbereiches nicht leer ist, dann
End If
 
 'Bereich von bis wird geleert
 Range("A7:G7").ClearContents
 
 
 'Bildschirm darf wieder zappeln
 Application.ScreenUpdating = True
 
 'Kopiermodus beenden
 Application.CutCopyMode = False
End Sub
 

Atillas Code: Verbesserung von Steffl, der aber leider Schauan seinen Part nicht mehr realisiert, die tabellarische Einordnung.

Sub Zeile_kopieren()
  Dim lngC As Long
  'Zappel nicht!
  Application.ScreenUpdating = False

  With Worksheets("Datenmaske")
     lngC = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
     If lngC = 3 Then
       If Application.CountA(Range("A2:G2")) = 0 Then lngC = 2
     End If
       
     'Bereich kopieren
     Sheets("Eingabemaske").Range("A7:G7").Copy
     
     'einfügen in erste freie Zeile in ausgabe
     .Cells(lngC, 1).PasteSpecial xlPasteValues
  End With
  Worksheets("Eingabemaske").Range("A7,C7,E7:F7").ClearContents

  'Zappel wieder!
  Application.ScreenUpdating = True

  'Kopiermodus beenden
  Application.CutCopyMode = False
End Sub

Zwei Teile und eine Verbesserung und dennoch kommen wir nicht ans Ziel. . .  :22:

[Scolex2015]

Ich werde verrückt, nachdem ich mir nochmal eine Büchse Relentless eingeholfen habe, habe ich es tatsächlich geschafft den Code von drei Leuten erfolgreich zu verschmelzen. Was für euch vermutlich eine 5 Minuten Nummer ist, hat mich fast 30min Googleübersetzung gekostet. Umso größer ist jetzt aber die Erfolgsfreude. 

Speziellen Dank nochmal an die drei Topcodebastler "Steffl " / "Atilla" / "Schauan")!!! 

Code:

'START ATILLA
Sub Zeile_kopieren()
Dim lngC As Long

  'Zappel nicht!
Application.ScreenUpdating = False

With Worksheets("Datenmaske")
lngC = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If lngC = 3 Then
If Application.CountA(Range("A2:G2")) = 0 Then lngC = 2
End If

   'Bereich kopieren
Sheets("Eingabemaske").Range("A7:G7").Copy
'END ATILL
   
   
' START SCHAUAN - Wenn letzte Zeile des Tabellenbereiches nicht leer ist, dann
If Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).Value <> "" Then
 
  'unter dem Bereich einfuegen
Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
 
  'ansonsten
Else

  'nochmal nach oben und dann unter den Daten einfuegen
Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

  'Ende Wenn letzte Zeile des Tabellenbereiches nicht leer ist, dann
End If
'END SCHAUAN
   
'START STEFFL
End With
Worksheets("Eingabemaske").Range("A7,C7,E7:F7").ClearContents
'END STEFFL
   
   

 'Zappel wieder!
 Application.ScreenUpdating = True

 'Kopiermodus beenden
 Application.CutCopyMode = False
End Sub

Ich hoffe ihr verzeiht mir meine Planlosigkeit. Excel VBA Einführung ist bestellt und ich werde mich intensiver mit der VBA Sprache beschäftigen, da es mir Spaß gemacht hat, mit euch herrum zu basteln!   :100:
Falls es jetzt optische Optimierungen gibt, immer raus damit. Funktioniert auf jedenfall wunderbar.  

:05:  :05:  :05: