Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

spalten

Forumthread: spalten

spalten
11.08.2022 14:08:21
Klaus
Hallo zusammen,
ich habe 15 Tabellenblätter mit verschiedenen Namen,
kann man per Makro in jeden Tabellenblatt spalte C , Spalte F, Spalte G und Spalte J in einem neuen Tabellenbaltt zuammen ziehen.
Das ich dann alle daten untereinander habe.
z.b alle Tabellenblätter spalte C werte nehmen und in neuen Tabellen blatt in C untereinander eintragen, danach F usw.
Wäre sowas möglich
Danke
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: spalten
11.08.2022 16:59:03
Yal
Hallo Klaus,
probiere folgendes:

Sub Spalten_kopieren()
Dim wsQ As Worksheet 'Q wie Quelle
Dim wsZ As Worksheet 'Z wie Ziel
Dim C 'C wie Column
Dim ZielZeile As Long
Dim i As Long
Set wsZ = ThisWorkbook.Worksheets("Ergebnis")
For Each wsQ In ThisWorkbook.Worksheets
i = 0
For Each C In Array("C", "F", "G", "J")
i = i + 1
If wsQ.Name  wsZ.Name Then
If i = 1 Then ZielZeile = NeueZeile(wsZ.Range("A:D"))
wsQ.Range(wsQ.Cells(1, C), wsQ.Cells(Rows.Count, C).End(xlUp)).Copy
wsZ.Cells(ZielZeile, i).PasteSpecial xlPasteValues
End If
Next
Next
End Sub
Private Function NeueZeile(R As Range)
Dim C As Range
Dim Erg As Long
For Each C In R.Columns
Erg = WorksheetFunction.Max(Erg, R.Parent.Cells(Rows.Count, C.Column).End(xlUp).Row)
Next
NeueZeile = Erg
End Function
VG
Yal
Anzeige
AW: spalten
11.08.2022 17:15:47
GerdL
Moin Klaus,
die direkte Antwort ist "ja". Teste mal.

Sub Unit()
Dim x As Worksheet, Ws As Worksheet, lz As Long
'Neues Blatt als Zielblatt eingügen
Set x = ThisWorkbook.Worksheets.Add(before:=ThisWorkbook.Sheets(1))
x.Name = "Uebersicht"
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name  x.Name Then
lz = Ws.Cells(Ws.Rows.Count, 3).End(xlUp).Row
Union(Ws.Range("C2:C" & lz), Ws.Range("F2:G" & lz), Ws.Range("J2:J" & lz)).Copy _
Destination:=x.Cells(x.Rows.Count).End(xlUp).Offset(1)
End If
Next
Set x = Nothing
End Sub
Gruß Gerd
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige