Office: Tabellenblätter M:M auslesen; in neues Blatt auflisten

Hallo, da bin ich wieder mit einem neuen Problem.

Benötige Hilfe beim Auslesen meherer Tabellenblätter.
Ist es möglich, dass Daten aus Spalten M:M + N:N + P:P ab Zelle 14 bis unendlich aus
den Tabellenblättern, die mit dem Namen "2008-" anfangen, permanent ausgelesen werden können und in einem neuen Tabellenblatt in (z.B. B:B + C:C + D:D ab Zeile 6 bis unendlich )untereinander aufgelistet werden?
Jedoch sollten diese nur aufgelistet werden sobald M:M ab Zelle 14 in der Quelle auch bechrieben wurde (Wenn z.B. Spalte M:M Zelle 14 keinen Eintrag hat, soll diese und die weiteren 2 Positionen ( N:N + P:P jeweils Zelle 14 ) nicht aufgelistet werden. Wäre auch Platzverschwendung!)

Gruß Timi

 

Hallo!

Teste es mal, indem du diesen Code ins Modul des neuen Tabellenblatts kopierst:

Code:

Private Sub Worksheet_Activate()
Dim ws As Worksheet, i As Long
Range("6:65536").Clear
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 5) = "2008-" Then
ws.Range("M14:P" & ws.Range("M65536").End(xlUp).Row).Copy
Cells(WorksheetFunction.Max(6, Range("A65536").End(xlUp).Row + 1), 2).PasteSpecial Paste:=xlValues
End If
Next ws
Columns(3).Delete
For i = Range("A65536").End(xlUp).Row To 6 Step -1
If IsEmpty(Cells(i, 2)) Then Rows(i).Delete
Next i
End Sub

Der Name des neuen Blatts sollte allerdings NICHT mit "2008-" beginnen.

 

Mit VBA zumindest ja. Ob man mit Formeln auch was werden kann? Dazu würde mir jetzt der Ansatz fehlen. Aber in VBA ist das relativ simpel mit ein paar Schleifen zu erledigen.

Schauen wir mal...

Code:

trg="Zielblatt" 'ergebnis-blatt
y2=5 'ab zeile 6 (geht mit +1 los...)
for i=1 to worksheets.count 'alle blätter
  if left$(worksheets(i).name,5)="2008-" 'die mit "2008-" beginnen
    for y1=14 to worksheets(i).usedrange.rows.count 'ab zeile 14 bis ende
      if trim$(worksheets(i).cells(y1,13).value)<>"" 'spalte m nicht leer?
        y2=y2+1 'zielblatt nächste zeile
        worksheets(trg).cells(y2,13).value=worksheets(i).cells(y1,2).value 'm nach b
        worksheets(trg).cells(y2,14).value=worksheets(i).cells(y1,3).value 'n nach c
        worksheets(trg).cells(y2,16).value=worksheets(i).cells(y1,4).value 'p nach d
      endif
    next y1
  endif
next i

(Das ist jetzt mal völlig ungetestet und aus dem Stegreif heraus! Mind. 2 Erweiterungen würden mir einfallen:

a) Das Blatt "Zielblatt" muß bereits existieren und sollte sinnvollerweise völlig leer sein. Denkbar wäre, das neue Blatt ebenfalls von VBA aus erzeugen zu lassen.

b) y2=y2+1
Das könnte, genügend Datensätze vorausgesetzt, ganz fix über 65536 (und damit das Zeilen-Limit) hinaus gehen und dann eine Fehlermeldung verursachen. Hier wäre also ggf. noch eine IF-Abfrage einzubauen, um das zu verhindern.

Das Ergebnis wird übrigens so erstellt, daß im Ziel die Werte völlig ohne Formatierung stehen. Alternativ ließe sich das mit "copy" und "pastespecial" erledigen, wobei man dann auch setzen kann, ob die Werte direkt, oder auch die formeln kopiert werden sollen. Naja, viele Wege führen nach Rom...

Wie auch immer, den Code kann man dann auf diverseste Form in die Mappe bekommen. Eine der leichtesten ist vielleicht, mit dem Makro-Rekorder ein neues Makro aufzuzeichnen (mit Hotkey-Vergabe), die Aufzeichnung nach der ersten Aktion abzuschalten, den VBA-Editor aufrufen und den Code im aufgezeichneten Makro mit Obigem ersetzen.

Viel Erfolg... ;-)

Gruß, Michael

 

Hab' beide Anweisungen ausprobiert und es klappt nicht. Das einzige was kopiert wird sind die Bezeichnungen der Spalten, aber nicht der Inhalt der Spalten. Eine Formel ( wenn die überhaupt erstellbar wäre ) wäre auch OK.
Habe schon mit SVERWEIS rumgetüfftelt, jedoch ohne Erfolg. Das Problem ist, das alle Tabellenblätter, die mit "2008-" anfangen, durchsucht werden müssen. Mit einem Tabellenblatt krieg' ich's hin, aber gleich mehrere, das übersteigt meine Fähigkeiten.
Mein Problem mal geschildert:
Möchte eine Rechnung schreiben. Füge eine Artikelnummer ein, und es soll automatisch mit Bezeichnung,Preis,Käufer,Auftragnummer etc. ausgefüllt werden. Die Artikelnummern mit den dazugehörigen Angaben stehen immer an der gleichen Position, jedoch auf den gewissen Tabellenblätter, die mit "2008-" anfangen, zerstreut. SVERWEIS müsste nun all dieTabellenblätter, die mit "2008-" anfangen durchsuchen. Dies bekomme ich nicht hin.
Daher die Idee, des Kopierens aller Daten der Tabellenblätter, welche mit "2008-" anfangen auf ein einziges, damit ich mit SVERWEIS weiter arbeiten kann.
Gruß Timi

 

Hallo!

Mein Code hatte noch ein bis zwei Tippfehler, aber so klappt es bei mir:

Code:

Private Sub Worksheet_Activate()
Dim ws As Worksheet, i As Long
Range("6:65536").Clear
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 5) = "2008-" Then
ws.Range("M14:P" & ws.Range("M65536").End(xlUp).Row).Copy
Cells(WorksheetFunction.Max(6, Range("A65536").End(xlUp).Row + 1), 2).PasteSpecial Paste:=xlValues
End If
Next ws
Columns(4).Delete
For i = Range("B65536").End(xlUp).Row To 6 Step -1
If IsEmpty(Cells(i, 2)) Then Rows(i).Delete
Next i
End Sub

 

In meiner Variante war leider ein kleiner Fehler:

Code:

worksheets(trg).cells(y2,13).value=worksheets(i).cells(y1,2).value 'm nach b

Hier (und den beiden Folge-Zeilen) hab ich doch glatt Quelle und Ziel wervechselt! Tausche hier bitte die 13 mit der 2 aus, in den beiden nächsten Zeilen entsprechend.

Ansonsten müßte es aber funktionieren. Und wenn Excel beim Ausführen des Makros blöde meckert wegen nicht deklarierten Variablen, weil ganz oben ein "option explicit" steht:

Code:

dim trg as string
dim y2 as long
dim i as long
dim y1 as long

Und das zwischen die Zeile mit "Sub ..." und der Zeile mit "trg=..." setzen.

Gruß, Michael


Gruß, Michael

 

Habe mich nochmals daran versucht.
Bei dem einen Blatt, welches mit 2008- anfängt(2008-001) reagiert mein neues Tabellenblatt erst ab M17 und folgende und kopiert diese Werte in sich hinein.
Bei dem anderen Blatt(2008-002) reagiert das neue Tabellenblatt erst ab M18 und folgende, und schreibt diese Werte in sich hinein.
Die Werte von M14 -M16 werden im ersten Fall nicht übernommen, sowie im zweiten die Werte von M14-M17.
Komisch? Bin ich zu blöd für diese Welt? :shock:

Betrifft die Formel von Schatzi!

 

Hab' noch einen Fehler korrigiert:

Code:

Private Sub Worksheet_Activate()
Dim ws As Worksheet, i As Long
Range("6:65536").Clear
For Each ws In ThisWorkbook.Worksheets
If Left(ws.Name, 5) = "2008-" Then
ws.Range("M14:P" & ws.Range("M65536").End(xlUp).Row).Copy
Cells(WorksheetFunction.Max(6, Range("B65536").End(xlUp).Row + 1), 2).PasteSpecial Paste:=xlValues
End If
Next ws
Columns(4).Delete
For i = Range("B65536").End(xlUp).Row To 6 Step -1
If IsEmpty(Cells(i, 2)) Then Rows(i).Delete
Next i
End Sub

 

Hab jetzt zwei Versionen parallel laufen.
Die von miriki und die von Schatzi.

Folgendes wird bei der Formel von miriki angezeigt:
FEHLER BEIM KOMPILIEREN!
Syntaxfehler

if left$(worksheets(i).name,5)="2008-" 'die mit "2008-" beginnen

if trim$(worksheets(i).cells(y1,13).value)<>"" 'spalte m nicht leer?

Die Formel von Schatzi wird nun auf Herz und Nieren geprüft! Ergebnis folgt!

 

Hallo!

Bei miriki fehlt in diesen Zeilen jeweils das "Then".

 

Hallo Schatzi,

kann das sein, das bei Deiner Anweisung auch noch Bereiche oberhalb der Zeilen 14 mitgeschleppt werden?
Ist bei mir der Fall.
In diesem Fall die Spaltenbeschreibung. Wäre nicht schlimm, jedoch wird sie bei mir im neuen Tabellenblatt unten eingefügt und nicht oben
Ansonsten läuft diese Anweisung bis jetzt reibungslos!

Gruß Timi

 

Hallo!

Eigentlich kann das höchstens passieren, wenn ab Zeile 14 überhaupt keine Daten vorhanden sind.
Sonst kann ich mir das nicht erklären...

 

Worksheets(trg).Cells(y13, 2).Value = Worksheets(i).Cells(y1, 2).Value 'm nach b
Worksheets(trg).Cells(y14, 2).Value = Worksheets(i).Cells(y1, 3).Value 'n nach c
Worksheets(trg).Cells(y16, 2).Value = Worksheets(i).Cells(y1, 4).Value 'p nach d

wird bei miriki gelb unterlegt mit gelbem Pfeil auf die ganze Zeile.
Laufzeitfehler 9

Könnt ihr mir da weiterhelfen?

Gruß Timi

 

Eigentlich kann das höchstens passieren, wenn ab Zeile 14...

Hallo Schatzi, Du hattest Recht mit den leeren Zellen.
Da ist ja noch das Musterblatt(2008-Muster), welches typischerweise ohne Inhalt ist.
Habe "TEST" in die Zellen reingeschrieben und schon funktionierts!

Vielen Dank!

 

Noch ein Problem,
SVERWEIS zu diesem neuen Tabellenblatt mit kopierten Daten nicht möglich, da diese Daten erst drinstehen, wenn ich es öffne; also nicht permant abgespeichert und aktualisiert werden.
Die Liste erstellt sich leider erst nach dem Öffnen des Blattes, somit kann SVERWEIS dort drin ja auch nix finden, wenn ich auf einem anderen Blatt Daten brauche.

Gru? Timi