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
| A | B | C | D | E |
1 | | Feld_A01 | Feld_B01 | Feld_A02 | Feld_B02 |
2 | | A_AZ01 | A_BZ01 | B_AZ01 | B_BZ01 |
Formeln der Tabelle |
Zelle | Formel | 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