12.3k Aufrufe
Gefragt in Tabellenkalkulation von petra65 Experte (1.8k Punkte)
Hallo,

mal wieder ein Problem....

Ich habe eine Tabelle, die aus diversen Tabellenblättern besteht. Ich möchte nun in ein bestimmtes Tabellenblatt (2009) Daten anderer Tabellenblätter (1-70) holen. Das heisst, jedesmal wenn ich die Zellen fülle, sollen diese übertragen werden (entweder beim Speichern oder über Enter).

Der Aufbau ist wie folgt:

Tabellenblatt 2009:
Hier soll in A5 der Wert von M3 aus den jeweiligen Blättern übergeben werden.
In B5 soll der Wert aus M4 übergeben werden.
In C5 bis P5 sollen die Werte aus A9 bis N9.

Die Tabellenblätter, aus denen die Daten geholt werden sollen, sind fortlaufend nummeriert, von 1 bis 70.

Ich denke, dass das nur mit Makros funktioniert, und mit denen komme ich überhaupt nicht klar - darum hoffe ich hier auf Hilfe.

Vielen Dank im voraus und viele Grüße - Petra

23 Antworten

0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi rainer ^^

dein code ein wenig optimiert

gruss nighty

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Dim ws1 As Worksheet, ws2 As Worksheet
Dim strKunde As String, strKnr As String
Set ws1 = ThisWorkbook.ActiveSheet
Set ws2 = ThisWorkbook.Worksheets("2009")
If Target.Row < 9 Or Target.Column <> 15 Then Exit Sub
strKnr = ws1.Range("M3").Value
strKunde = ws1.Range("M4").Value
If UCase(Target.Value) = "X" Then
ws2.Cells(ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = strKnr
ws2.Cells(ws2.Cells(Rows.Count, 1).End(xlUp).Row, 2).Value = strKunde
ws1.Range("A" & ws1.Cells(Rows.Count, 1).End(xlUp).Row & ":N" & ws1.Cells(Rows.Count, 1).End(xlUp).Row).Copy
Sheets("2009").Range("C" & ws2.Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Application.CutCopyMode = False
End If
Application.EnableEvents = True
End Sub
0 Punkte
Beantwortet von rainberg Profi (14.9k Punkte)
Halloy,

@nighty
danke für Deinen Hinweis, war in Zeitnot.

Mein Makro hatte auch noch einen weiteren Fehler es wurde die falsche Zeile kopiert.
Hier die Korrektur.

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ws1 As Worksheet, ws2 As Worksheet
Dim strKunde As String, strKnr As String
Set ws1 = ThisWorkbook.ActiveSheet
Set ws2 = ThisWorkbook.Worksheets("2009")
If Target.Row < 9 Or Target.Column <> 15 Then Exit Sub
Application.EnableEvents = False
strKnr = ws1.Range("M3").Value
strKunde = ws1.Range("M4").Value
If UCase(Target.Value) = "X" Then
ws2.Cells(ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = strKnr
ws2.Cells(ws2.Cells(Rows.Count, 1).End(xlUp).Row, 2).Value = strKunde
ws1.Range("A" & Target.Row & ":N" & Target.Row).Copy
Sheets("2009").Select
Range("C" & ws2.Cells(Rows.Count, 1).End(xlUp).Row).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Application.CutCopyMode = False
Range("A5").Select
End If
Application.EnableEvents = True
End Sub


@Petra
anbei die geänderte Datei

www.file-upload.net/download-1558114/re2_TESTdatei.xls.html

Gruß
Rainer
0 Punkte
Beantwortet von petra65 Experte (1.8k Punkte)
Hallo,

ihr seid ja echt genial ;-)))))))

Habe mal alle 3 Varianten ausprobiert,

am Besten haben mir das 1. Makro (Antwort 17, Automatismus) - erweitert um eine Spalte "Daten übertragen", und das letzte Makro (Antwort 22) gefallen.
Wobei das 1. Makro nicht in die Tabelle 2009 springt, sondern in dem Tabellenblatt bleibt.

Weiss nun gar nicht was sinnvoller ist ;-)

Vielen, vielen Dank ...

Gruss - Petra
...