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

Spalten aus verschiedenen Arbeitsblättern kopieren

Spalten aus verschiedenen Arbeitsblättern kopieren
JR_OFF
Hallo,
ich bitte um Hilfe bei einem Problem bzw. Frage zu Excel (2007).
Ich habe eine Arbeitsmappe mit zwei Tabellenblättern
Beide Arbeitsblätter sind in der Struktur ähnlich bzw. gleich aufgebaut.
Jeweils enthalten beide Tabellenblätter sehr, sehr viele Spalten (ca. 200).
Anzahl der gefüllten Spalten kann unterschiedlich sein
Ich möchte in einem weiteren Tabellenblatt jeweils gleiche Spalten (A, B, C usw.) nebeneinander kopieren.
Beispiel:
Spalte A aus Tabellenblatt 1 soll in Spalte B in Tabellenblatt 3
Spalte A aus Tabellenblatt 2 soll in Spalte C in Tabellenblatt 3
Spalte B aus Tabellenblatt 1 soll in Spalte D in Tabellenblatt 3
Spalte B aus Tabellenblatt 2 soll in Spalte E in Tabellenblatt 3
Spalte C aus Tabellenblatt 1 soll in Spalte F in Tabellenblatt 3
Spalte C aus Tabellenblatt 2 soll in Spalte G in Tabellenblatt 3
usw.
Ich bin für jeden Tipp dankbar, sei es per Formel und oder VBA
Davon unabhängig, wie kann ich schnell bei sehr vielen Spalten eine Leerspalte zwischen jede Spalte einfügen.
Im Voraus vielen Dank und viele Grüsse

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

Betreff
Benutzer
Anzeige
AW: Spalten aus verschiedenen Arbeitsblättern kopieren
20.07.2011 18:57:16
Tino
Hallo,
kannst mal diesen Code versuchen, Tabellen im Code evtl. noch anpassen.
Sub Start() Dim SH1 As Worksheet, SH2 As Worksheet, SHZiel As Worksheet Dim MaxCol&, n&, nCol& With Application .ScreenUpdating = False .EnableEvents = False Set SH1 = Tabelle1 'Tabelle1 evtl. anpassen Set SH2 = Tabelle2 'Tabelle2 evtl. anpassen Set SHZiel = Tabelle3 'Tabelle3 Ziel evtl. anpassen With SH1.UsedRange MaxCol = .Columns(.Columns.Count).Column End With With SH2.UsedRange MaxCol = Application.Max(MaxCol, .Columns(.Columns.Count).Column) End With nCol = 1 For n = 1 To MaxCol SH1.Columns(n).Copy SHZiel.Columns(nCol) SH2.Columns(n).Copy SHZiel.Columns(nCol + 1) nCol = nCol + 2 Next n .ScreenUpdating = True .EnableEvents = True End With End Sub Gruß Tino
Anzeige
AW: Spalten aus verschiedenen Arbeitsblättern kopieren
20.07.2011 19:26:55
fcs
Hallo JR_OFF,
per Formel könnte man es auch machen, aber die Funktion INDIREKT mit entsprechender Berechnung der Spalten überfrachtet bei über 200 Spalten und entsprechender Zeilenzahl das Tabellenblatt.
Tabelle3

 ABCDE
1 Feld_A01Feld_B01Feld_A02Feld_B02
2 A_AZ01A_BZ01B_AZ01B_BZ01

Formeln der Tabelle
ZelleFormel
B1=INDIREKT("'"&"Tabelle1" & "'!Z"& ZEILE() & "S" &  SPALTE()/2;FALSCH)
C1=INDIREKT("'"&"Tabelle2" & "'!Z"& ZEILE() & "S" &  GANZZAHL(SPALTE()/2); FALSCH)
D1=INDIREKT("'"&"Tabelle1" & "'!Z"& ZEILE() & "S" &  SPALTE()/2;FALSCH)
E1=INDIREKT("'"&"Tabelle2" & "'!Z"& ZEILE() & "S" &  GANZZAHL(SPALTE()/2); FALSCH)
B2=INDIREKT("'"&"Tabelle1" & "'!Z"& ZEILE() & "S" &  SPALTE()/2;FALSCH)
C2=INDIREKT("'"&"Tabelle2" & "'!Z"& ZEILE() & "S" &  GANZZAHL(SPALTE()/2); FALSCH)
D2=INDIREKT("'"&"Tabelle1" & "'!Z"& ZEILE() & "S" &  SPALTE()/2;FALSCH)
E2=INDIREKT("'"&"Tabelle2" & "'!Z"& ZEILE() & "S" &  GANZZAHL(SPALTE()/2); FALSCH)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Nachfolgend Makro-Lösungen zu beiden Frangen.
Gruß
Franz
Sub CopySpalten()
Dim Spalte As Long, SpalteLetzte As Long, SpalteZiel As Long
Dim wks1 As Worksheet, wks2 As Worksheet, wksZiel As Worksheet
Dim wb As Workbook
Set wb = ActiveWorkbook
'Namen in den nachfolgenden 3 Zeilen ggf. anpassen oder durch Index-Nummern ersetzen
Set wks1 = wb.Worksheets("Tabelle1") 'oder auch wb.Worksheets(1)
Set wks2 = wb.Worksheets("Tabelle2") 'oder auch wb.Worksheets(2)
Set wksZiel = wb.Worksheets("Tabelle3") 'oder auch wb.Worksheets(3)
Application.ScreenUpdating = False
With wksZiel
'Alle Daten ab Spalte B im Zielblatt löschen
SpalteLetzte = .Cells.SpecialCells(xlCellTypeLastCell).Column
If SpalteLetzte > 1 Then
.Range(.Columns(2), .Columns(SpalteLetzte)).EntireColumn.Delete
End If
End With
'letzte Spalte in Tabelle1/Tabelle2
SpalteLetzte = wks1.Cells(1, wks1.Columns.Count).End(xlToLeft).Column
SpalteLetzte = Application.WorksheetFunction.Max(SpalteLetzte, _
wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column)
SpalteZiel = 1
For Spalte = 1 To SpalteLetzte
Application.StatusBar = "Spalte " & Spalte & " von " & SpalteLetzte & " wird kopiert"
SpalteZiel = SpalteZiel + 1
wks1.Columns(Spalte).Copy Destination:=wksZiel.Columns(SpalteZiel)
SpalteZiel = SpalteZiel + 1
wks2.Columns(Spalte).Copy Destination:=wksZiel.Columns(SpalteZiel)
Next Spalte
With Application
.ScreenUpdating = True
.StatusBar = False
End With
MsgBox "Fertig"
End Sub
Sub aLeerspalten()
'Leerspalten einfügen
Application.ScreenUpdating = False
'in der nachfolgenden Zeile ggf. die Parameter anpassen/weglassen
Call EinfuegenLeerspalten(wks:=ActiveSheet, SpalteDiff:=1, SpalteBreite:=8, _
SpalteStart:=1, sNumberFormat:="General")
Application.ScreenUpdating = True
End Sub
Sub EinfuegenLeerspalten(wks As Worksheet, Optional SpalteDiff As Long = 1, _
Optional SpalteStart As Long = 1, Optional SpalteBreite As Double, _
Optional sNumberFormat As String)
'Leerspalten einfügen, Optional mit Spaltenabstand und Spaltenbreite
'wks = Tabelenblatt in dem Leerspalten eingefügt werden sollen
'SpalteDiff = Anzahl Spalten zwischen den Leerspalten
'SpalteStart = Spalte nach der die 1. Leerspalte eingefügt werden soll
'SpalteBreite = Breite der eingefügten Leerspalten
'sNumberformat = Zahlenformat der eingefügten Leerspalten
'werden SpalteBreite und/oder sNumberformat nicht angegeben, _
dann wird das Format von der linke Nachbarspalte übernommen
Dim Spalte As Long, SpalteLetzte As Long
With wks
SpalteLetzte = .Cells.SpecialCells(xlCellTypeLastCell).Column
For Spalte = SpalteLetzte To SpalteStart Step -1
If (Spalte + SpalteStart - 1) Mod SpalteDiff = 0 Then
.Columns(Spalte + 1).Insert
If Not IsMissing(SpalteBreite) Then .Columns(Spalte + 1).ColumnWidth = SpalteBreite
If Not IsMissing(sNumberFormat) Then .Columns(Spalte + 1).NumberFormat = sNumberFormat
End If
Next
End With
End Sub

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen