Werte aus anderen Tabellen

[Sebastian]

Bin leider ein noob in Excel besonders Makros.

Hab seit 5 Jahren meine „tolle“ Excel Tabelle mit 4 Makros.
Eigentlich zufrieden, jedoch könnte es besser funktionieren. Besonders der Jahresabschluss.

Es gibt am Anfang zwei Tabellen; eine Monatstabelle und eine Abschlusstabelle.
In der Monatsbelle werden die Werte eingetragen und Makros gestartet, letztes Makro ist für speichern zuständig, damit wird die Tabelle Jänner erstellt und so weiter bis Dezember.
Ende Dezember hab ich dann in meiner Mappe, die zwei Tabellen vom Beginn und die 12 neuen Tabellen Jänner, Februar, März etc. bis Dezember. (ohne Jahr)
Bis jetzt habe ich immer erst im Dezember zum Jahresende, die wichtigsten Werte auf die Abschlusstabelle kopiert mit diesem Makro. Leider ist das erst im Dezember möglich, sonst gibt es Fehlermeldungen.
Jetzt meine Bitte.
Möchte ein Makro haben welches ich Quartals / nach 4 Monaten, einfach zum beliebigen Zeitpunkt starten kann.
Eine Art Wenn Funktion; wenn Tabelle Jänner vorhanden dann Wert B7 in der Abschlusstabelle anzeigen. Makro ist/soll in der Tabelle Abschlusstabelle sein.
Ihr könnt, da sicher Helfen. Danke

Code:

Sub Monateübertragen()
'
' Monateübertragen Makro
' Alle Monate von Jänner bis Dezember werden übertragen.
'
'
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "=Jänner!R42C14"
    Range("B8").Select
    ActiveCell.FormulaR1C1 = "=Februar!R42C14"
    Range("B9").Select
    ActiveCell.FormulaR1C1 = "=März!R42C14"
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "=April!R42C14"
    Range("B11").Select
    ActiveCell.FormulaR1C1 = "=Mai!R42C14"
    Range("B12").Select
    ActiveCell.FormulaR1C1 = "=Juni!R42C14"
    Range("B13").Select
    ActiveCell.FormulaR1C1 = "=Juli!R42C14"
    Range("B14").Select
    ActiveCell.FormulaR1C1 = "=August!R42C14"
    Range("B15").Select
    ActiveCell.FormulaR1C1 = "=September!R42C14"
    Range("B16").Select
    ActiveCell.FormulaR1C1 = "=Oktober!R42C14"
    Range("B17").Select
    ActiveCell.FormulaR1C1 = "=November!R42C14"
    Range("B18").Select
    ActiveCell.FormulaR1C1 = "=Dezember!R42C14"
    Range("C5").Select
End Sub

[GMG-CC]

Moin Sebastian,

obwohl ich ein VBA-Fan bin steht hier aus meiner Sicht eine PivotTable im Vordergrund und wäre gewiss viel erfolgsversprechender.

[Sebastian]

Hallo.

Mag sein, das will ich aber nicht.

Ich bin mir sicher es gibt ein Makro auch.

Hier noch das Makro Speichern

Private Function SheetExists(sname) As Boolean
Application.DisplayAlerts = True

' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
Application.DisplayAlerts = False
End Function
-------------------------------------

Sub Speichern()

Cells.Select
Selection.Copy
Dim merker As String
merker = Sheets("Monatstabelle").Range("e1")
If SheetExists(merker) Then Sheets(merker).Delete
Sheets("Monatstabelle").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = merker
ActiveSheet.Range("d1").Select
ActiveSheet.Unprotect Password:="...."
ActiveSheet.Shapes("Drop Down 1").Select
Selection.Delete
ActiveSheet.Unprotect Password:="...."

ActiveSheet.Columns("Ac:Ae").Hidden = True
ActiveSheet.Protect Password:="...."
Sheets("Monatstabelle").Select
Range("D2").Select
End Sub


Aber Bitte dieses Makro nicht bearbeiten oder auch keine Vorschläge schicken.
Es Funktioniert, also soll es so bleiben.

[GMG-CC]

Um bei deiner Ausdrucksweise zu bleiben:

Na dann viel Spaß beim Lernen der VBA-Grundlagen!
Wenn ich mir den obigen Code ansehe, hast du noch einen etwas weiteren Weg vor dir.

Und klar ist das möglich!

[Sebastian]

Um bei deiner Ausdrucksweise zu bleiben:

Na dann viel Spaß beim Lernen der VBA-Grundlagen!
Wenn ich mir den obigen Code ansehe, hast du noch einen etwas weiteren Weg vor dir.

Und klar ist das möglich!

Guten Abend Günther.

Als erstes finde ich es großartig, dass es Menschen gibt wie dich und viele andere hier, die einem hier helfen. Danke dafür.

Jedoch ist dein Kommentar nicht hilfreich.

Ich möchte keine Pivot Tabelle, sondern ein Makro.

Auch bin ich mir bewusst, dass mein Makro sehr laienhaft ist.
Könnte ich es besser, dann würde ich nicht fragen.
Deshalb suche ich um Hilfe.

Wenn du nicht willst oder nicht kannst, ist es deine Sache, aber bitte spar dir diese Kommentare.
Gute Nacht

[GMG-CC]

Zwei Dinge dazu:

1. Ein Forum sollte immer (nur) Hilfe zur Selbsthilfe geben, keine kompletten Lösungen.
Und 2. siehst du den Unterschied im Schlüsselwortß

"Mag sein, das will ich aber nicht."
...
"Ich möchte keine Pivot Tabelle, sondern ein Makro."

Es ist alles eine Frage der Ausdrucksweise. Und im obigen Beitrag hast du uns Helfern gegenüber das was wir als Helfer als Minimum erwarten können: Respekt. Ich mag mit meiner Meinung vielleicht alleine da stehen, aber ich empfinde es als Normal, wenn meine Kunden (die für derartige Dienstleistungen bezahlen) auch noch "Danke" sagen, was dann auch gut tut. Ein schönes Sprichwort sagt: "Der Ton macht die Musik." Und so war mein erster Satz gemeint.

Das Programm oben ist aufgezeichnet, das ist ja auch OK. Besser, als gar nichts "in den Ring werfen". Und dass du es gleich zu Beginn mit eingebracht hast, finde ich positiv.

So, und jetzt sage ich auch "Gute Nacht"

[Rabe]

Hi Sebastian,

Ich bin mir sicher es gibt ein Makro auch.

naja, "geben" tut es das sicher noch nicht. Das muß ja genau auf Deine Gegebenheiten angepasst sein.
Das muß jemand erstellen.

Aber Bitte dieses Makro nicht bearbeiten oder auch keine Vorschläge schicken.
Es Funktioniert, also soll es so bleiben.

und das finde ich auch lustig: Du schreibst, Du bist Anfänger und benötigst Hilfe, willst aber nicht an Deinem funktionierenden Makro gezeigt bekommen, wie es kürzer sein und die Aufgabe effektiver gelöst werden kann. Das heißt, Du willst nicht lernen, sondern vorgekaute Lösungen und das hat Günther (negativ) angemerkt.

Versuche es mal mit diesem Makro anstelle von Deinem (ich probiere es jetzt nicht aus, denn ich habe ja Deine Datei nicht und auch keine Lust, sie nachzubauen):

Sub Monateübertragen()

  ' 

  ' Monateübertragen Makro 

  ' Alle Monate von Jänner bis Dezember werden übertragen, sofern vorhanden. 

  ' 

  ' 

  If SheetExists("Jänner") Then Range("B7").FormulaR1C1 = "=Jänner!R42C14"

  If SheetExists("Februar") Then Range("B8").FormulaR1C1 = "=Februar!R42C14"

  If SheetExists("März") Then Range("B9").FormulaR1C1 = "=März!R42C14"

  If SheetExists("April") Then Range("B10").FormulaR1C1 = "=April!R42C14"

  If SheetExists("Mai") Then Range("B11").FormulaR1C1 = "=Mai!R42C14"

  If SheetExists("Juni") Then Range("B12").FormulaR1C1 = "=Juni!R42C14"

  If SheetExists("Juli") Then Range("B13").FormulaR1C1 = "=Juli!R42C14"

  If SheetExists("August") Then Range("B14").FormulaR1C1 = "=August!R42C14"

  If SheetExists("September") Then Range("B15").FormulaR1C1 = "=September!R42C14"

  If SheetExists("Oktober") Then Range("B16").FormulaR1C1 = "=Oktober!R42C14"

  If SheetExists("November") Then Range("B17").FormulaR1C1 = "=November!R42C14"

  If SheetExists("Dezember") Then Range("B18").FormulaR1C1 = "=Dezember!R42C14"

  Range("C5").Select

End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

Wenn das funktioniert, dann hattest Du die Lösung schon in Deinem ersten Beitrag

Eine Art Wenn Funktion; wenn Tabelle Jänner vorhanden dann Wert B7 in der Abschlusstabelle anzeigen

und in Deiner selbst definierten Funktion SheetExists stehen, die Du vermutlich auch von jemand anders vorgekaut bekommen und nicht versucht hast, zu verstehen.

[RPP63]

Hi Sebastian (und Ralf)!
Ich bin kein Österreicher, nehme aber an, dass die (eingebauten) benutzerdefinierten Listen dort genauso aussehen.
(Jänner statt Januar in Deutschland)
Dann kann man viel Bildschirmtinte sparen.  :19:

Sub Monate()

Dim MonLang, cnt As Long

MonLang = Application.GetCustomListContents(8)

For cnt = 1 To Ubound(MonLang)

  If SheetExists(MonLang(cnt)) Then Cells(6 + cnt, 2).FormulaR1C1 = "=" & MonLang(cnt) & "!R42C14"

Next

End Sub

Gruß Ralf

[RPP63]

… aus SheetExists() habe ich auch mal das Überflüssige rausgeschmissen:

Private Function SheetExists(sname) As Boolean
Dim x As Worksheet
On Error Resume Next
   Set x = ActiveWorkbook.Sheets(sname)
   If Err = 0 Then SheetExists = True
End Function

Gruß Ralf

[Sebastian]

Danke Ralf und Ralf.

Haut hin, so hab ich es mir vorgestellt.
Schon toll, wenn man sich in VBA auskennt.