Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
808to812
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
808to812
808to812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spalteninhalte in ein Blatt kopieren

Spalteninhalte in ein Blatt kopieren
15.10.2006 20:41:49
Wolfgang
Hallo*
ich habe folgende Konstellation, mit dem Makrorekorder versucht, aber irgendwie funktioniert das nicht: In einer Arbeitsmappe befinden sich ca. 20 Tabellenblätter (variabel); Der Überschaubarkeit wegen würde ich gerne aus diesen Tabellenblättern jeweils den Inhalt aus Spalte A in ein neues Tabellenblatt, welches dann über den Code zu generieren wäre und den Namen "Ergebnisse" erhalten sollte, kopieren. Das neue Blatt sollte hinter Blatt "Lieferantenübersicht" eingefügt werden. Die Daten aus den jeweiligen Tabellenblättern sollen dann ab Spalte A2 fortlaufend je Blatt eine Spalte eingefügt werden. In A1 sollte dann der Tabellenblattname, aus dem die Daten kopiert wurden, als Überschrift stehen. Kann mir jemand helfen, wie ich das mit dem Makrorekorder realisieren kann oder wie evtl. so ein Code aussehen könnte? - Danke schon jetzt für die Rückantworten.
Gruß - Wolfgang

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalteninhalte in ein Blatt kopieren
15.10.2006 21:34:43
Erich
Hallo Wolfgang,
ganz klar ist mir das nicht geworden, aber vielleicht habe ich ja deinen Wunsch getroffen:
Sub SpaltenA_sammeln()
Dim wsE As Worksheet, ws As Worksheet, lngZ As Long, intS As Integer
'  Sheets("Ergebnisse").Delete
ActiveWorkbook.Worksheets.Add(after:=Sheets("Lieferantenübersicht")).Name = "Ergebnisse"
Set wsE = ActiveSheet
wsE.Rows(1).HorizontalAlignment = xlCenter
For Each ws In ActiveWorkbook.Worksheets
With ws
If ws.Name <> "Ergebnisse" Then
lngZ = .Cells(Rows.Count, 1).End(xlUp).Row
lngZ = IIf(lngZ < Rows.Count, lngZ, lngZ - 1)
intS = intS + 1
wsE.Cells(1, intS) = ws.Name
Range(.Cells(1, 1), .Cells(lngZ, 1)).Copy wsE.Cells(2, intS)
wsE.Columns(intS).AutoFit
End If
End With
Next ws
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Danke Peter und Erich!!
16.10.2006 06:05:25
Wolfgang
Hallo Erich und Peter,
ich bin sehr erfreut über Eure Rückmeldungen; Mir ist nun klar geworden, dass ich das mit dem Makrorekorder niemals hinbekommen hätte. Danke auch wieder für die ausführlichen Informationen zu den einzelnen Schritten, da weiß man als Laie, warum und weshalb der Code so geschrieben ist und kann wieder daraus lernen. Ich werde nachher beide Codes testen und "einbauen"; Danke an Euch Beiden für Eure Rückmeldung und für die Arbeit/Zeit die Ihr für meine Frage investiert und aufgebracht habt.
Herzliche Grüße
Wolfgang
AW: Spalteninhalte in ein Blatt kopieren
15.10.2006 21:46:04
Peter
Hallo Wolfgang,
das nachfolgende Makro sollte es tun - wenn ich dich richtig verstanden habe ...

Sub Zusammenfuehren()
Dim WkSh_Q    As Worksheet                   ' Tabellenblätter
Dim WkSh_Z    As Worksheet
Dim iBlatt    As Integer
Dim bVorhand  As Boolean                     ' Schalter Falsch/Wahr
Dim lZeile_Q  As Long
Dim lZeile_Z  As Long
Dim iSpalte   As Integer
Application.ScreenUpdating = False
For iBlatt = 1 To Worksheets.Count                ' jedes Blatt der Mappe
If Worksheets(iBlatt).Name = "Ergebnisse" Then ' ist es gleich "Ergebnisse" ?
bVorhand = True                             ' dann Schalter auf 'Gefunden'
Exit For                                    ' und For/Next verlassen
End If
Next iBlatt                                       ' nächstes Tabellenblatt
If bVorhand = True Then                           ' Blatt vorhanden ?
Worksheets("Ergebnisse").Cells.ClearContents
Else
Worksheets.Add after:=Worksheets("Lieferantenübersicht")
ActiveSheet.Name = "Ergebnisse"
End If
Set WkSh_Z = Worksheets("Ergebnisse")
For iBlatt = 1 To Worksheets.Count  ' jedes Blatt der Mappe
If Worksheets(iBlatt).Name <> "Ergebnisse" Then ' ist es gleich "Ergebnisse" ?
Set WkSh_Q = Worksheets(Worksheets(iBlatt).Name)
lZeile_Q = WkSh_Q.Range("A65536").End(xlUp).Row
Go

Sub Kopieren
End If
Next iBlatt                                 ' nächstes Tabellenblatt
Application.ScreenUpdating = True
Exit Sub
Kopieren:
iSpalte = iSpalte + 1
WkSh_Z.Cells(1, iSpalte).Value = WkSh_Q.Name
For lZeile_Z = 2 To lZeile_Q
WkSh_Z.Cells(lZeile_Z, iSpalte).Value = _
WkSh_Q.Range("A" & lZeile_Z - 1).Value
Next lZeile_Z
Return
End Sub

Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Anzeige
AW: Spalteninhalte in ein Blatt kopieren
15.10.2006 22:17:00
Peter
Hallo Reiner,
eine kleine Korrektur:
https://www.herber.de/bbs/user/37401.xls
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.
Eine Frage noch:
16.10.2006 06:16:10
Wolfgang
Hallo Erich und Peter,
man kann es ja doch nicht lassen, somit habe ich gerade noch beide Codes getestet; Sie laufen auf den ersten Blick beide sehr gut. - Ich hatte wohl nur vergessen, und sorry dafür, direkt zu fragen, was gemacht werden muß, wenn das Blatt "Lieferantenübersicht" nicht mit einbezogen werden soll. Wäre schön, wenn ich dazu noch einen Hinweis bekommen könnten. Danke schon jetzt wieder dafür.
Herzliche Grüße - Wolfgang
Anzeige
AW: Eine Frage noch:
16.10.2006 06:49:43
Erich
Hallo Wolfgang,
dafür kannst du in Peters Code die Zeile
      If Worksheets(iBlatt).Name  "Ergebnisse" Then ' ist es gleich "Ergebnisse" ?
ersetzen durch
      If Worksheets(iBlatt).Name  "Ergebnisse" And Worksheets(iBlatt).Name  "Lieferantenübersicht" Then ' ist es gleich "Ergebnisse" ?
Im Code von mir ersetzt du die Zeile
         If ws.Name  "Ergebnisse" Then
durch
         If ws.Name  "Ergebnisse" And ws.Name  "Lieferantenübersicht" Then
oder besser
         If ws.Name  wsE.Name And ws.Name  "Lieferantenübersicht" Then
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Eine Frage noch:
16.10.2006 08:33:59
Erich
Hallo Wolfgang,
Peters und meinen Code habe ich noch zusammengebaut zu
Sub SpaltenA_sammeln()
Dim intB As Integer, ws As Worksheet, lngZ As Long, intS As Integer
For intB = 1 To Worksheets.Count                   ' jedes Blatt der Mappe
If Worksheets(intB).Name = "Ergebnisse" Then Exit For ' ist es gleich "Ergebnisse" ?
Next intB                                          ' nächstes Tabellenblatt
If intB <= Worksheets.Count Then                   ' wenn Blatt vorhanden,
Worksheets(intB).Activate                          ' Blatt aktivieren
Cells.Clear                                        ' Blattinhalt löschen
Else                                               ' sonst Blatt anlegen
Worksheets.Add(after:=Sheets("Lieferantenübersicht")).Name = "Ergebnisse"
End If
Application.ScreenUpdating = True                  ' Bildschirmaktualisierung ausschalten
For Each ws In Worksheets                          ' Schleife über alle Tabellenblätter
With ws
If .Name <> "Ergebnisse" And .Name <> "Lieferantenübersicht" Then
lngZ = .Cells(Rows.Count, 1).End(xlUp).Row   ' letzte belegte Zeile in Spalte A
lngZ = IIf(lngZ < Rows.Count, lngZ, lngZ - 1)  ' ohne Zeile 65536
intS = intS + 1
Cells(1, intS) = .Name                       ' Blattname als Spaltennüberschrift
' Kopieren in Spalte intS ab Zeile 2
Range(.Cells(1, 1), .Cells(lngZ, 1)).Copy Cells(2, intS)
Columns(intS).AutoFit                        ' Spaltenbreite optimal
End If
End With
Next ws
Rows(1).HorizontalAlignment = xlCenter             ' Zeile 1 zentrieren
Application.ScreenUpdating = True                  ' Bildschirmaktualisierung einschalten
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
Danke Peter und Erich!!
16.10.2006 19:29:05
Wolfgang
Hallo Peter und Erich,
leider kann ich mich jetzt erst melden, nachdem ich nun Feierabend habe und mich sofort wieder in die Forumsseite geloggt habe. Ich bin schon einigermaßen überwältigt über Eure Hilfestellung sowie die erneuten Codes bzw. Änderungen und freue mich sehr. Beide Codes laufen auch zu dieser Fragestellung und ich glaube, dass ich nun die weiteren Umstellungen bzw. Ergänzungen hinbekomme. Wenn nicht, darf ich mich sicherlich erneut melden (?); Danke nochmals für Eure große Hilfestellung und weiterhin alles Gute.
Herzliche Grüße
Wolfgang
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige