Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1376to1380
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
Inhaltsverzeichnis

Daten in mehrern Abbeitsblättern transponieren

Daten in mehrern Abbeitsblättern transponieren
04.09.2014 08:10:13
Lemmi
Hallo zusammen,
ich möchte mit einem Makro Daten in mehreren Arbeitsblättern transponiren.
Die Daten liegen zur Zeit immer in A1 bis X100 in gleicher Art und Weise vor.
Zur Zeit bearbeitet ich die Daten wie folgt:
Ich makiere die Daten und kopiere die Daten über Inhalte einfügen transponieren wieder an anderer Stelle des jeweiligen Arbeitsblatt wieder ein.
Die Ursprungsdaten lösche ich, um dann die transponierten Daten nach A 1 und folgende zu verschieben.
Dies wiederhole ich für jedes Arbeisblatt.
Dies würde ich gerne in einem Marko mit allen Arbeitsblätten durchführen.
Gruß
Lemmi

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten in mehrern Abbeitsblättern transponieren
04.09.2014 10:08:49
Martin
Hallo Lemmi,
und so sieht das Makro aus:
Sub Makro1()
Dim objWsh As Worksheet, varInhalt As Variant
For Each objWsh In ActiveWorkbook.Sheets
With objWsh
varInhalt = Application.Transpose(.Range("A1:X100").Value)
.Cells.Clear
.Range("A1").Resize(UBound(varInhalt, 1), UBound(varInhalt, 2)) = varInhalt
End With
Next
End Sub
Viele Grüße
Martin

Vorschlag: WorkSheets statt Sheets ...
04.09.2014 10:28:51
Matthias
Hallo

    Vorschlag: WorkSheets statt Sheets,
    sonst kommt bei einem evtl. vorhandenen Diagramm o.A eine Fehlermeldung!
  • Bei Sheets durchläuft die Schleife alle Blätter

  • Bei WorkSheets eben nur WorkSheets


Gruß Matthias

Anzeige
...überredet ;-)
04.09.2014 10:36:19
Martin
Also nimm lieber folgendes Makro:
Sub Makro1()
Dim objWsh As Worksheet, varInhalt As Variant
For Each objWsh In ActiveWorkbook.Worksheets
With objWsh
varInhalt = Application.Transpose(.Range("A1:X100").Value)
.Cells.Clear
.Range("A1").Resize(UBound(varInhalt, 1), UBound(varInhalt, 2)) = varInhalt
End With
Next
End Sub
Viele Grüße
Martin

AW: ...überredet ;-)
04.09.2014 13:04:35
Lemmi
Hallo Ihr beiden,
vielen Dank für Eure Lösung! Es funktioniert soweit alles!
Allerdings habe ich bei der Listung feststellen müssen, dass die erste Spalte nicht immer gefüllt ist.
Deshalb müsste das Marko noch ergänzt werden.
Währe es also möglich, das zunächst geprüft werden kann ob Zellen in Spalte A leer ist. Ist eine Zelle in Spalte A leer so soll der Eintrag "Name fehlt" eingebracht werden.
Es soll nur soweit die Spalte A mit "Name fehlt" gefüllt werden, soweit in den Spalten B-X Inhalte vorhanden sind.
Vielen Dank schon einmal im Vorraus!
Gruß
Lemmi

Anzeige
SpecialCells(xlCellTypeBlanks) ...
04.09.2014 13:42:16
Matthias
Hallo
With Range("A1:A100").SpecialCells(xlCellTypeBlanks)
.Value = "Name fehlt"
End With
Gruß Matthias

AW: SpecialCells(xlCellTypeBlanks) ...
04.09.2014 15:35:31
Martin
Hallo Lemmi,
ich war unterwegs und antworte deshalb erst jetzt. Ich fahre gleich noch 400 Kilometer Auto und kann deshalb nur noch bis 16 Uhr antworten. Der Vorschlag von Matthias klappt ist zwar grundsätzlich richtig, aber dann MUSS es leere Zellen geben in Spalte A geben (...dann kommt eine Fehlermeldung).
Hier mein Vorschlag:
Sub Makro1()
Dim objWsh As Worksheet, varInhalt As Variant
For Each objWsh In ActiveWorkbook.Worksheets
With objWsh
With .Range("A1:A100").SpecialCells(xlCellTypeBlanks)
If .Count > 0 Then .Value = "Name fehlt"
End With
varInhalt = Application.Transpose(.Range("A1:X100").Value)
.Cells.Clear
.Range("A1").Resize(UBound(varInhalt, 1), UBound(varInhalt, 2)) = varInhalt
End With
Next
End Sub
Viele Grüße
Martin

Anzeige
AW: SpecialCells(xlCellTypeBlanks) ...
04.09.2014 15:35:37
Martin
Hallo Lemmi,
ich war unterwegs und antworte deshalb erst jetzt. Ich fahre gleich noch 400 Kilometer Auto und kann deshalb nur noch bis 16 Uhr antworten. Der Vorschlag von Matthias klappt ist zwar grundsätzlich richtig, aber dann MUSS es leere Zellen geben in Spalte A geben (...dann kommt eine Fehlermeldung).
Hier mein Vorschlag:
Sub Makro1()
Dim objWsh As Worksheet, varInhalt As Variant
For Each objWsh In ActiveWorkbook.Worksheets
With objWsh
With .Range("A1:A100").SpecialCells(xlCellTypeBlanks)
If .Count > 0 Then .Value = "Name fehlt"
End With
varInhalt = Application.Transpose(.Range("A1:X100").Value)
.Cells.Clear
.Range("A1").Resize(UBound(varInhalt, 1), UBound(varInhalt, 2)) = varInhalt
End With
Next
End Sub
Viele Grüße
Martin

Anzeige
AW: SpecialCells(xlCellTypeBlanks) ...
04.09.2014 15:46:02
Lemmi
Hallo Matthias,
wie binde ich diesen Teil ein?
Gruß
Lemmi

AW: SpecialCells(xlCellTypeBlanks) ...
04.09.2014 15:49:59
Martin
Hallo Lemmi,
das habe ich dir doch gerade "optimiert" geschrieben?!
Viele Grüße
Martin

AW: SpecialCells(xlCellTypeBlanks) ...
04.09.2014 16:06:50
Lemmi
Hallo Martin,
sorry hatte ich nicht gesehen!
Danke! Danke!
Gruß
Lemmi

da wir gerade beim Optimieren waren ...
04.09.2014 17:01:54
Matthias
Hallo
Da wir gerade dabei waren uns gegeseitig zu ergänzen :-)
Folgendes:
Bitte erstelle ein leeres Worksheet und positioniere es als letztes Tabellenblatt(WorkSheet).
Und nun bitte den Code laufen lassen.
Hier sollte also auch noch eine Überprüfung rein!
Gruß Matthias
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige