Werte einer aktiven (markierten) Zelle in eine bestimmte, andere Zelle einfügen[Excel

[GSSK54]

Ich danke dir!! Ich glaube der Ansatz wird mir weiterhelfen. Bzgl. der KW-Nummerierung muss ich ne Alternative finden da hast du recht! Super, echt.

[GSSK54]

Gibt es ein paar coole Tutorials oder Lehrbücher, wo man VBA gut lernen kann? 
Da hab ich ein ziemliches Defizit und würde das ganze mal langsam angehen. Mathematisch check ich das, hatte auch schon mal Informatik mit Matlab etc. aber die Sprache kann ich irgendwie nicht lernen. Wäre cool wenn ihr da n paar Empfehlungen für mich haben würdet :) Danke nochmal

[Frogger1986]

Und hier die Makrolösung.. Gebe dem Makro eine Tastenkombination, markiere den KW- Bereich und löse das Makro mit der Kombi aus...


mir hat der sehr geholfen:

https://www.excel-vba-lernen.de/

Der macht das klasse und Schritt für Schritt von Anfang an..

Code:

Sub Datensetzen()

On Error GoTo Ende

Bereich = Selection.Address
Bereichstart = Left(Bereich, InStr(Bereich, ":") - 1)
Bereichende = Right(Bereich, Len(Bereich) - InStr(Bereich, ":"))
       
ActiveSheet.Range("D14").Value = ActiveSheet.Range(Bereichstart).Value
ActiveSheet.Range("E14").Value = ActiveSheet.Range(Bereichende).Value

Nettowsr1 = Range(Bereichstart).Row + 5
Nettowsc1 = Range(Bereichstart).Column

Nettowsr2 = Range(Bereichende).Row + 5
Nettowsc2 = Range(Bereichende).Column


ActiveSheet.Range("D15").Value = ActiveSheet.Cells(Nettowsr1, Nettowsc1).Value
ActiveSheet.Range("E15").Value = ActiveSheet.Cells(Nettowsr2, Nettowsc2).Value

ActiveSheet.Range("D16").Value = WorksheetFunction.Sum(Range(Cells(Nettowsr1, Nettowsc1), Cells(Nettowsr2, Nettowsc2))) / 2

Ende:

End Sub

[Frogger1986]

Hier noch die Lösung mit Formel bei mehreren gleichen Werten... Die Hilfszeile hab ich ausgeblendet.. Zeile(1)

Ein gut gemeinten Rat habe ich noch... Lass in Bereichen, in denen Berechnungen statt finden, das Verbinden der Zellen! das führt ganz oft zu falschen Ergebnissen!!!

[GSSK54]

ECHT VIELEN DANK!...
Das scheint ne Heidenarbeit zu sein, echt korrekt! Das erste was ich ab morgen machen werde, ist dass ich mir VBA beibringen werde. Danke für die wertvollen Tipps und die klasse Unterstützung.

[Käpt'n Blaubär]

Hallo,

Das scheint ne Heidenarbeit zu sein, echt korrekt! Das erste was ich ab morgen machen werde, ist dass ich mir VBA beibringen werde. 

viel Spaß beim Beibringen :05: .
und weil nicht jeder mit Videos gut lernen kann, hier noch 'ne kleine Starthilfe und die Warnung, daß das was Du da jetzt tun willst ganz
schnell süchtig macht. Es weckt nämlich Begehrlichkeiten und Lust nach mehr  :19:

[Frogger1986]

Ich hab noch zwei Fehler festgestellt die ich in der eile gestern gemacht habe! Im Anhang die Berichtigten Tabellen für beide Versionen! (Formel und VBA)

Code:

Sub Datensetzen()

On Error GoTo Ende

Bereich = Selection.Address
Bereichstart = Left(Bereich, InStr(Bereich, ":") - 1)
Bereichende = Right(Bereich, Len(Bereich) - InStr(Bereich, ":"))
       
ActiveSheet.Range("D14").Value = ActiveSheet.Range(Bereichstart).Value
ActiveSheet.Range("E14").Value = ActiveSheet.Range(Bereichende).Value

Nettowsr1 = Range(Bereichstart).Row + 7
Nettowsc1 = Range(Bereichstart).Column

Nettowsr2 = Range(Bereichende).Row + 7
Nettowsc2 = Range(Bereichende).Column


ActiveSheet.Range("D15").Value = ActiveSheet.Cells(Nettowsr1, Nettowsc1).Value
ActiveSheet.Range("E15").Value = ActiveSheet.Cells(Nettowsr2, Nettowsc2).Value

Diviesor = (Nettowsc2 + 1) - Nettowsc1

ActiveSheet.Range("D16").Value = WorksheetFunction.Sum(Range(Cells(Nettowsr1, Nettowsc1), Cells(Nettowsr2, Nettowsc2))) / Diviesor

Ende:

End Sub