Office: Wert in Zelle kopieren und in nächster freie Zelle einfügen

Hallo zusammen,

ich habe jetzt schon etwas länger recherchiert, habe aber vermutlich nen dickes Brett vorm Kopf ;-)
Mein Problem möchte ich gerne im VBA als Makro erledigen.
In der Zelle F4 ist ein errechneter Wert(Währung Euro), diesen möchte ich kopieren
und in der nächsten freien Zelle in B einfügen.
Das ganze sollte sich aber nur auf das ausgewählte Tabellenblatt beziehen ( In diesem Fall "T3").
Da mehrere identische Blätter bestehen und jedes sich selbst berechnen soll.
Generell klingt das vermutlich recht leicht, aber wie gesagt das Brett.
Eine Datei hänge ich an

Mit freundlich Grüßen
Philipp

 

Geil. Blattschutz mit Passwort.

 

Entschuldigung, mein Fehler.
Hier ohne Blattschutz.

 

Hallo Philipp,

warum so kompliziert? Das gehört alles in eine Datentabelle. Auf einem Auswertungsblatt kannst du alle gewünschten Daten zusammen fassen.

 

Hallo

Eigentlich hat Klaus-Dieter Recht, aber wenn es trotzdem in der Registerverteilung bleiben soll, würde ich es mit Power Query machen damit erspart du dir die Formeln im Register "Haupt".

 

Moin Philip,
nachdem ich dem guten Hinweis von KD (erst alles in eine Tabelle, dann die Auswertungen) nichts hinzuzufügen habe, nur noch dies: Ich finde nicht, dass das Forum wissen muss, dass Dein T16 wohl eine etwas schlechte Zahlungsmoral hat.

Einfache Tricks, wie man solche Tabellen DSGVO-konform auch von Hamburg aus ins Netz stellt, gibt es unzählige. Als erster Vorschlag: Lass über die Namensspalten ein kleines Makro (Code in Deinem Arbeitsblatt) laufen, das die Realnamen auf ihre erste drei Zeichen beschränkt:

Code:

Option Explicit

Sub Anonymizer()
Dim rng As Range, rCell As Range
Dim sValue As String

Set rng = Range("B3:B33")
For Each rCell In rng
    sValue = Left(rCell.Value, 3)
    rCell.Value = sValue
Next
End Sub

Nachdem die Namen in anderen Spalten per Formel erscheinen, musst Du keine weiteren Ranges definieren (zumindest nicht in Tabelle HAUPT).

Vertrauliche Grüße

 

Hallo,
Nachdem es jetzt viele schlaue Beiträge gab wie man es besser macht und anonymisiert, Frage ich nochmal ob es dazu eine Funktion gibt wie im Post beschrieben
Ich möchte die Datei nicht großartig ändern.

Mit freundlichen Grüßen
Philipp

 

Hallo Philipp,

habe deine Datei mal so umgebaut, wie ich mir das vorstellen könnte. Die neuen Daten werden einfach auf dem Blatt "Datenblatt" unten angefügt.

 

@ Philipp Neise ... 'tschuldigung für eine Anmerkung im Interesse Deiner Kollegen...
Dich möchte ich nicht als solchen.

 

Danke gleichfalls(auch wenn die Meinungen auf der Schicht anders sind), also gehe ich auch mal davon aus das niemand eine lösung für mein vorhandenes Problem posten möchte.

 

Nö - es wären ja doch nur "schlaue Sprüche"

btw: Meine Kaffeekassenabrechnung habe ich gestern Abend in 'ner halben Stunde von Null auf fertig geschrieben - mit genau einer Tabelle

 

Du hast doch Lösungsansätze, wenn auch nicht auf Deine Datei bezogen.
Warum fragst Du Dich nicht einfach mal selbst, warum Dir jeder von Deinem Ansatz abrät?
Du denkst "in Papier", wenngleich Denken in Datenstrukturen der erheblich bessere Ansatz wäre.

Musst Du ja gar nicht, bloß erwarte nicht, dass Du dann konkrete Hilfe bekommst.

Gruß Ralf

 

Hallo Philipp,

rate mir, aber rate mir nicht ab .... leider eine weit verbreitete Einstellung von Fragestellern. Es ist einfach nicht so, dass niemand eine Lösung für dein Problem finden möchte. So bin ich schon der Meinung, einen solchen Vorschlag gemacht zu haben, auch wenn der von deiner Vorstellung abweicht. Die EDV soll dazu dienen, komplizierte Dinge zu vereinfachen, du gehst mit deinem Projekt eher in die andere Richtung. Dann brauchst du dich nicht wundern, wenn hilfswillige da nicht mitgehen (können / wollen).

 

Hallo,

ich habe mich daran gemacht und habe deine vielen Arbeitsblätter belassen, wie sie sind. Aufgefallen ist mir dort aber, dass an manchen Stellen offenbar suboptimale Formelteile enthalten sind, wie zB.
Zelle B2: =WENN(C1=0;"";SUMME(C5-B5+I3))
das müsste doch wohl lauten: =WENN(C1="";"";C5-B5+I3)
oder Zelle F4: =SUMME('T4'!F3*HAUPT!L3)
das sollte sinnvollerweise so zu ändern sein: =F3*HAUPT!L3
Diese Formeln habe ich nur im Arbeitsblatt "T3" abgeändert.

Dafür habe ich 99 enthaltene Makros durch bloß 3 Makros ersetzt und habe die darauf zugreifenden Buttons entsprechend anders verknüpft.

Code:

Sub Oeffnen_T_MA()
    Dim Ws As Worksheet
    Dim ButtonTxt As String, Zeile As Long, Spalte As Long
    Dim MA_Name As String
  
    Set Ws = ActiveSheet
  
    'Ermittle Zelle, in der der "Öffnen"-Button geklickt wurde:
    With Ws.Shapes(Application.Caller).TopLeftCell
      Zeile = .Row
      Spalte = .Column
      'MsgBox "Zelle in (" & Zeile & ", " & Spalte & ")"
    End With
  
    'Ermittle Arbeitsblattname des MA (aus Spalte A):
    MA_Name = Ws.Cells(Zeile, Spalte).EntireRow.Cells(1).Value
  
    'Blende Arbeitsblatt des MA ein, aktiviere es, springe zu F3
    With Worksheets(MA_Name)
       .Visible = True
       .Activate
       .Range("F3").Select
    End With
End Sub

'Falls es sich um ein MA-Arbeitsblatt handelt,
'wird der Wert aus Zelle F4 in die Spalte B der ersten freien Zeile kopiert

Sub F4_in_Leerzeile_SpalteB_Kopieren()
   Dim LztZeile As Long
  
   With ActiveSheet
      If .Name Like "T#*" Then
         LztZeile = .Cells(Rows.Count, 2).End(xlUp).Row
         .Cells(LztZeile + 1, 2).Value = .Range("F4").Value
      Else
         MsgBox Prompt:="Das Arbeitsblatt " & .Name & vbNewLine & _
                "ist kein MA-Arbeitsblatt!", _
                Buttons:=vbCritical + vbOKOnly, _
                Title:="Falsches Blatt"
      End If
   End With
End Sub
Sub Next_T_MA()

   Dim Ws_T_MA As Worksheet, Ws_T_MA_next As Worksheet
   Dim T_MA_next As String
  
   Set Ws_T_MA = ActiveSheet
   T_MA_next = "T" & (Mid$(Ws_T_MA.Name, 2) + 1)
  
   Ws_T_MA.Visible = xlSheetHidden
   With Worksheets(T_MA_next)
     .Visible = xlSheetVisible
     .Activate
     .Range("F3").Select
   End With

End Sub

Die bisherigen 99 Makros habe ich in Kommentar umgewandelt - sie sind also noch als Text enthalten.

Darüber hinaus habe ich ein weiteres Makro eingefügt, um deinen Wunsch zu entsprechen: Falls es sich um ein MA-Arbeitsblatt handelt, wird der Wert der Zelle F4 hinunterkopiert in die Spalte B der ersten freien Zeile:

Code:

Sub F4_in_Leerzeile_SpalteB_Kopieren()
   Dim LztZeile As Long
  
   With ActiveSheet
      If .Name Like "T#*" Then
         LztZeile = .Cells(Rows.Count, 2).End(xlUp).Row
         .Cells(LztZeile + 1, 2).Value = .Range("F4").Value
      Else
         MsgBox Prompt:="Das Arbeitsblatt " & .Name & vbNewLine & _
                "ist kein MA-Arbeitsblatt!", _
                Buttons:=vbCritical + vbOKOnly, _
                Title:="Falsches Blatt"
      End If
   End With
End Sub

Die etwas sperrige Makrobezeichnung "F4_in_Leerzeile_SpalteB_Kopieren" kannst du ja selbst abändern und gegebenenfalls einem Button zuweisen.

Datei liegt bei.

 

Hallo PhilippN,

das deine Tabelle gruselig aufgebaut ist, wurde dir ja bereits mehrfach kund getan und das muss ich leider auch bestätigen.

Aber um deinem Eigenwillen evtl. ein wenig unter die Arme zu greifen.....
Der Code fügt, wie von dir gewünscht, den errechnet Betrag in die nächste freie Zeile (Spalte B) und setzt die Stückzahl in F2 auf 0 zurück, zusätzlich wird in Spalte A der Zeile das aktuelle Datum eingetragen.
Vlt. kannst du davon was in deinem "Knoten" gebrauchen.

Code:

Sub SetAbrechnen()
Dim letztezeile As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
letztezeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    Range("F4").Copy
    Range("B" & letztezeile + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A" & letztezeile + 1) = Date
    Range("F3").FormulaR1C1 = "0"
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

P:S.
Exl121150 war schneller und fleißiger.
Ich lass mein ..... dennoch hier stehen. Wenn auch nur für dich zum lernen.