gleiche Spaltenüberschriften kopieren
20.11.2012 16:41:04
Constantin
nach vielen Versuchen mit hin- und herkopieren möchte ich gerne ein Programm (aus dem Forum)verwenden, das mir die Spalteninhalte bei gleichen Überschriften von Tabelle1 nach Tabelle2 kopiert.
Wer kann mir helfen, nachstehendes Programm so anzupassen, dass ich die Zeilennummer der Quellüberschriften (Tabelle1) mit einer Variable festlegen kann und ebenso die Zeile, in der die Zielüberschriften stehen?
Beispiel: In Tabelle1 stehen die Überschriften in Zeile6 (ab Spalte 2) und in Tabelle2 in Zeile3.
Es sollen dann alle Spalteninhalte mit gleichen Überschriften übertragen werden. Das Programm möchte dann ich mit einem Commandbutton aufrufen.
Sub Spalten_übertragen()
Dim SpalteZiel As Integer, SpalteQuelle As Integer, rngSpalte As Range
Dim WsQuelle As Worksheet, wsZiel As Worksheet
'Tabellenblätter anpassen!
Set WsQuelle = Tabelle1
Set wsZiel = Tabelle2
'Schleife über alle Spalten der Quelle
For SpalteQuelle = 1 To WsQuelle.UsedRange.Columns.Count + WsQuelle.UsedRange.Column - 1
'Spalte im WsZiel suchen
Set rngSpalte = wsZiel.Rows(1).Find(WsQuelle.Cells(1, SpalteQuelle).Value, lookat:= _
xlWhole, LookIn:=xlValues)
'was gefunden`?
If Not rngSpalte Is Nothing Then
'Spaltennummer auslesen
SpalteZiel = rngSpalte.Column
'jetzt kannst du alles machen. z.B:
Intersect(WsQuelle.Columns(SpalteQuelle), WsQuelle.UsedRange).Copy Destination:=wsZiel. _
Cells(1, SpalteZiel)
End If
Next
End Sub
Grüße, Constantin