VBA für Dateneingabe
#1
Hallo, da mir jetzt die Zeit wegrennt und die Suche nicht zum gewünschten Erfolg führte... 
Ziel soll ein Button werden welchen Daten vom ersten Tabellenblatt (Eingabemaske) auf die zweite (Datenmaske) bringt. Der Code soll über VBA laufen und auf Wunsch werkeln.

Ziele:
Eingabemaske (Tabelle1) Zelle A7:G7 kopieren
Datenmaske (Tabelle2) Zellen einfügen (in eine Tabelle - A1 = Kopf, ab A2 kann es losgehen, natürlich immer schön eine neue Zeile erstellen und nicht überschreiben)
Eingabemaske Zellen A12:G12 leeren ohne das meine Formeln, Auswahllisten oder Formatierung zerstört wird

Hört sich eigentlich super einfach an, bis jetzt habe ich mir das hier zusammengestückelt..

Code:
Sub Dateneingabe()
  
   'Bildschirm höre auf zu zappeln!
   Application.ScreenUpdating = False
  
   'Bereich von bis wird kopiert
   Sheets("Eingabemaske").Range("A7:G7").Copy
  
   'Einfügen in erste freie Zeile in Datenmaske
   Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
   Leider trägt er mir das nicht in meine Tabelle ein, er fängt bei A3 unter der Tabelle an, da dieser Baustein geklaut ist und mich überfordert bin ich hier total hilflos!
  
   'Bereich von bis wird geleert
   Range("A7:G7").ClearContents
   Macht er super aber leider sind meine tollen Formeln und Bezüge weg, ein eintragen der Formel über VBA Code führt zu Fehlern.
  
   'Bildschirm darf wieder zappeln
   Application.ScreenUpdating = True
  
   'Kopiermodus beenden
   Application.CutCopyMode = False
End Sub

1) Wie sage ich Excel soll in meiner Tabelle anfangen und diese nach unten Erweitern?
2) Wie vermeide ich das er bei ClearContents meine Formeln  und Bezüge löscht?

Soviel dazu, beeindruckt mich!  :05: 
Vielen Dank im Vorraus!


Angehängte Dateien
.xlsm   UnkenntlichForum.xlsm (Größe: 28,25 KB / Downloads: 21)
Top
#2
Hallo,

vielleicht fehlt vor dem Rows noch das Worksheet

Code:
Sheets("Datenmaske").Cells(Sheets(""Datenmaske").Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

Genauso vor dem Clearcontents

Code:
Worksheets("Eingabemaske").Range("A7:G7").ClearContents
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • Scolex2015
Top
#3
Danke für die schnelle Meldung, aber Nein und Nein. Er fügt es ja Korrekt ein, nur unter der Tabelle ohne diese zu Erweitern. Er leert auch die richtigen Zellen, leider zu gründlich, mit Formel...  :22:
Top
#4
Hallo,

nächster Versuch

Code:
Sub Zeile_kopieren()
   Dim lngC As Long
   'Zappel nicht!
   Application.ScreenUpdating = False
  
   With Worksheets("Datenmaske")
      lngC = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
      
      '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
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • Scolex2015
Top
#5
Guter Mann, 50% hast du geschafft. Leider trägt er es immernoch nicht in die Tabelle ein. Los Stefan, alle guten Dinge sind drei!  :21:
Top
#6
Hallo,

das habe ich bei den Tests auch bemerkt. Du hast das als Tabelle formartiert und dadurch läßt Excel eine Zeile frei. Warum das so ist, weiß ich nicht. Wenn du die Formatierung entfernst wird die richtige Zeile ausgewählt.

Nachtrag: Dannach könntest Du die Daten wieder als Tabelle formatieren, dann sollte es nicht mehr ausmachen.
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • Scolex2015
Top
#7
Das ist ja gerade der Sinn, ich will die Eingaben irgendwann über die Tabelle Filtern, es muß doch eine Möglichkeit geben, Kumpelkeule VBA zu sagen, dass er in die Tabelle loslegen soll...

...das sollte vermutlich genau in dem Part passieren bei dem ich nur Bahnhof verstehe.

"Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues"

kannst du das mal bitte für mich ins deutsche Übersetzen?  Undecided
Top
#8
Hallöchen,

Excel lässt nicht unbedingt nur eine Zeile frei. Es könnten bei längeren Tabellen auch mehrere Zeilen frei sein.

Excel "springt" mit dem programmierten Befehl

Sheets("Datenmaske").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

erst einmal an das Ende des als Tabelle formatierten Bereiches - übrigens auch, wenn man das manuell ausführt. Ist die Tabelle voll, hat man Glück. Wenn nicht, muss man nochmal nach oben hüpfen.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • Scolex2015
Top
#9
Hmmm... macht Sinn aber er soll in die Tabelle hüpfen. Eine Idee?
Top
#10
Hallo zusammen,

mit Stefans Code wird nur dann eine Zelle unter der Tabelle angesprungen, wenn die Tabelle nur Überschriften hat.

Wenn ich da eine kleine Prüfung vorher einbaue, dann klappt es in vom TE eingestellten Datei.


Code:
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
EDIT:
Habe gerade getestet, so geht es auch:

Code:
Sub Zeile_kopieren()
  Dim lngC As Long
  'Zappel nicht!
  Application.ScreenUpdating = False
 
  With Worksheets("Datenmaske")
   lngC = Range("Tabelle1").Rows.Count + 1

       
     '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
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • Scolex2015
Top


Gehe zu:


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