Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
864to868
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
864to868
864to868
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Formate aus darüberliegender Zeile übernehmen

VBA Formate aus darüberliegender Zeile übernehmen
24.04.2007 19:30:06
Peter
Hallöchen noch mal,
ich habe vorhin mein 2.Problem vergessen.
Ich möchte das nach dem man eine neue Zeile am Ende angefügt hat die Formate aus der darüberliegenden Zeile übernommen werden. Mein Versuch funktioniert nicht. Wie muß es richtig ausehen?
(Der erste Teil des Codes kopiert in den Spalten in den Formeln stehen die Formeln und alles andere aus der über der aktiven Zeile liegenden Zeile in die nächste. Das soll auch so bleiben. Zusätzlich sollen wie schon beschrieben die Formate in jeder Spalte kopiert werden.)
Teil des Codes:
a = Cells(65536, 1).End(xlUp).Row - ActiveCell.Row + 1
For Each cell In Rows(ActiveCell.Row - 1).SpecialCells(xlCellTypeFormulas, 23)
cell.Copy Destination:=cell.Offset(1, 0).Resize(a, 1)
'For Each cell In Rows(ActiveCell.Row - 1) '.SpecialCells(xlCellTypeFormulas, 23)
'cell.AutoFill Destination:=cell.Offset(1, 0), Type:=xlFillFormats
Next
hier die ganze Datei: https://www.herber.de/bbs/user/41980.xls
Danke im Voraus
Grüße aus Berlin

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Formate aus darüberliegender Zeile übernehmen
25.04.2007 02:54:29
Daniel
Hallo
wo befindet sich der Code in deinem Projekt,
bei welcher aktion wird der Code aktiv?
ich kann vielleicht ein bisschen VBA, aber nicht hellsehen.
Gruß, Daniel

AW: VBA Formate aus darüberliegender Zeile übernehmen
25.04.2007 03:06:31
Daniel
Hallo
wo befindet sich der Code in deinem Projekt,
bei welcher aktion wird der Code aktiv?
ich kann vielleicht ein bisschen VBA, aber nicht hellsehen.
Außderdem fehlt in deinem Codeschnipsel ein (auskommentiertes) Next
Formate kann man auch mit:
Rows(x).copy
Rows(x+1).Pastespecial xlpasteformats
kopieren.
bei Formaten kannst du ja problemlos die ganze Zeile nehmen und musst nicht wie bei den Formeln die Zellen einzeln durchturnen.
du kannst aber auch die komplette Zeile von oben drüber kopieren und dann die Fixen Werte mit den Werten aus der Eingabebox überschreiben.
Dann hast du beide For-Next-Schleifen gespart.
Gruß, Daniel

Anzeige
AW: VBA Formate aus darüberliegender Zeile übernehmen
25.04.2007 21:03:22
Peter
Hallo Daniel,
der Code befindet sich in Formulare Userform "frmEingabe_neue_Zahlung".
Auf meinem Tabellenblatt habe ich ein Commandbutton der folgendes Makro startet (makro befindet sich in Tabelle2 Cashflow):

Private Sub neue_Zahlung_Click()
SpeedUp (True)
If MsgBox("Wollen Sie eine neue Zahlung einfügen ?", vbOKCancel + _
vbQuestion, "Achtung!") = 1 Then
frmEingabe_neue_Zahlung.Show
End If
SpeedUp (False)
End Sub


Nach "OK" zeigt sich die Userform "frmEingabe_neue_Zahlung".
Dort kann man diverse Einträge machen, die dann nach dem man den Commandbutton "cmdOK" angeklickt hat in bestimmte Spalte in die erste leere Zeile am Ende der Tabelle eingetragen werden.
Da sich die Tabelle dann um eine Zeile verlängert hat müssen Rahmen etc. in die neue Zeile übernommen werden.
Danach wird, je nach dem welches neue Datum in Spalte A in der neue Zeile steht die Tabelle aufsteigend sortiert.
Wenn ich den ganzen Inhalt (Formeln, Formate, Werte usw.) kopieren würde, werden die über die Userform neu eingetragenen Werte überschrieben. Den Code für das kopieren nur der Formeln brauche ich deswegen. Meine VBA-Kenntnisse sind nicht ausreichend um das Problem mit den Formaten zu lösen.
Code der Userform


Private Sub cmdOK_Click()
Dim cell As Range
Dim a As Long
Dim lbMsg As Byte
If Not IsDate(txtDatum.Text) = True Then
lbMsg = MsgBox("Geben Sie ein gültiges Datum ein", vbExclamation, "falsche Eingabe") _
txtDatum.Text = ""
txtDatum.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
If Not IsDate(txtfaellig_zum.Text) = True Then
lbMsg = MsgBox("Geben Sie ein gültiges Datum ein", vbExclamation, "falsche Eingabe") _
txtfaellig_zum.Text = ""
txtfaellig_zum.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
If cboAusgang_Eingang_Gesellschaft_Konto.Text = "Ausgang" Then
If Val(txtBetrag_Gesellschaft_Konto.Text) > 0 Then
lbMsg = MsgBox("Geben Sie einen negativen Wert ein", vbExclamation, " _
falsche Eingabe")
txtBetrag_Gesellschaft_Konto.Text = ""
txtBetrag_Gesellschaft_Konto.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
If Val(txtBetrag_MwSt.Text)  0 Then
lbMsg = MsgBox("Geben Sie einen negativen Wert oder 0 ein", vbExclamation, " _
falsche Eingabe")
txtBetrag_MwSt.Text = ""
txtBetrag_MwSt.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
End If
Range("A:A").Find("", after:=[A6]).Activate
ActiveCell.Value = CDate(Me.txtDatum)
ActiveCell.Offset(0, 1).Value = CDate(Me.txtfaellig_zum)
ActiveCell.Offset(0, 2).Value = Me.cboArt
ActiveCell.Offset(0, 3).Value = Me.txtGegenseite
ActiveCell.Offset(0, 4).Value = Me.txtZahlungsgrund
If Me.cboGesellschaft_Konto = "DA/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 5).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 10).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 6).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 9).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 13).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 10).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 14).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 9).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Kontokorrent Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 17).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 10).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Kontokorrent Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 18).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 9).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Kontokorrent Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 21).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 10).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Kontokorrent Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 22).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 9).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Treuhand Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 25).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 10).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Treuhand Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 26).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 9).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Treuhand Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 29).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 10).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "DA/Treuhand Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 30).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 9).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "AS/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 33).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AS/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 34).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "LB/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 37).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 42).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "LB/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 38).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 41).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "LB/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 45).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 42).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "LB/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 46).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 41).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "LHB/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 49).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 54).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "LHB/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 50).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 53).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "LHB/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 57).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 54).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "LHB/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 58).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
ActiveCell.Offset(0, 53).Value = CDec(Me.txtBetrag_MwSt)
End If
If Me.cboGesellschaft_Konto = "AW/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 61).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AW/Allgemeines Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 62).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AW/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 65).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AW/Allgemeines Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 66).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AW/Treuhand Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 69).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AW/Treuhand Lewa" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 70).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AW/Treuhand Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Ausgang" Then
ActiveCell.Offset(0, 73).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
If Me.cboGesellschaft_Konto = "AW/Treuhand Euro" And Me. _
cboAusgang_Eingang_Gesellschaft_Konto = "Eingang" Then
ActiveCell.Offset(0, 74).Value = CDec(Me.txtBetrag_Gesellschaft_Konto)
End If
Unload Me
a = Cells(65536, 1).End(xlUp).Row - ActiveCell.Row + 1
For Each cell In Rows(ActiveCell.Row - 1).SpecialCells(xlCellTypeFormulas, 23)
cell.Copy Destination:=cell.Offset(1, 0).Resize(a, 1)
'For Each cell In Rows(ActiveCell.Row - 1) '.SpecialCells(xlCellTypeFormulas, 23)
'cell.AutoFill Destination:=cell.Offset(1, 0), Type:=xlFillFormats
Next
Range("A6:CM2000").Sort Key1:=Range("A6"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns(1).Find(CDate(Me.txtDatum)).Select
End Sub


Kannst du mir entsprechende Änderungen am Code machen?
meine Datei: https://www.herber.de/bbs/user/42025.xls
Danke im Voraus
Grüße aus Berlin

Anzeige
AW: VBA Formate aus darüberliegender Zeile übernehmen
25.04.2007 22:36:43
Daniel
Hallo
hier der Code, den du einfügen musst.
Prinzip ist, daß du erst die Formeln und Formate von oben runterkopierst und dann erst die Fix-Werte reinschreiben. Dann sollte es kein Problem geben.
der neue Code sind die 2 Zeilen am ende, danach gehts normal weiter.
den unteren teil, der die Probleme macht, kannst du dann löschen.

Private Sub cmdOK_Click()
Dim cell As Range
Dim a As Long
Dim lbMsg As Byte
If Not IsDate(txtDatum.Text) = True Then
lbMsg = MsgBox("Geben Sie ein gültiges Datum ein", vbExclamation, "falsche Eingabe") _
txtDatum.Text = ""
txtDatum.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
If Not IsDate(txtfaellig_zum.Text) = True Then
lbMsg = MsgBox("Geben Sie ein gültiges Datum ein", vbExclamation, "falsche Eingabe") _
txtfaellig_zum.Text = ""
txtfaellig_zum.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
If cboAusgang_Eingang_Gesellschaft_Konto.Text = "Ausgang" Then
If Val(txtBetrag_Gesellschaft_Konto.Text) > 0 Then
lbMsg = MsgBox("Geben Sie einen negativen Wert ein", vbExclamation, " _
falsche Eingabe")
txtBetrag_Gesellschaft_Konto.Text = ""
txtBetrag_Gesellschaft_Konto.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
If Val(txtBetrag_MwSt.Text)  0 Then
lbMsg = MsgBox("Geben Sie einen negativen Wert oder 0 ein", vbExclamation, " _
falsche Eingabe")
txtBetrag_MwSt.Text = ""
txtBetrag_MwSt.SetFocus
cmdOK.Enabled = False
Exit Sub
End If
End If
Range("A:A").Find("", after:=[A6]).Activate
'neuer Code
ActiveCell.Offset(-1, 0).EntireRow.Copy Destination:=ActiveCell
ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
'ab hier dann normal weiter
ActiveCell.Value = CDate(Me.txtDatum)
ActiveCell.Offset(0, 1).Value = CDate(Me.txtfaellig_zum)


Gruß, Daniel

Anzeige
AW: VBA Formate aus darüberliegender Zeile übernehmen
26.04.2007 11:22:00
Peter
Danke, funktioniert bestens

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige