bestimmte Spalte in neues Blatt kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Kopieren() Dim WkSh_Q As Worksheet Dim WkSh_Z As Worksheet Dim rZelle As Range Dim aUeberschr As Variant Dim iIndx As Integer Dim iSpalte As Integer aUeberschr = Array("Depotnummer", "Depotbezeichnung", "Lagerort", "Menge") Application.ScreenUpdating = False Set WkSh_Q = Worksheets("Tabelle1") ' das Quell-Tabellenblatt Set WkSh_Z = Worksheets("Tabelle2") ' das Ziel-Tabellenblatt With WkSh_Q.Rows(1) For iIndx = 0 To UBound(aUeberschr) Set rZelle = .Find(aUeberschr(iIndx), LookAt:=xlWhole, LookIn:=xlValues) If Not rZelle Is Nothing Then iSpalte = iSpalte + 1 WkSh_Q.Columns(rZelle.Column).Copy Destination:=WkSh_Z.Columns(iSpalte) End If Next iIndx End With Application.ScreenUpdating = True End Sub

Hallo Uwe
hier eine Lösung, die ich ausprobiert habe.
Bei Const müssen die echten Feldnamen eingesetzt werden. z.B. Lager
In Set Tb1 + Tb2 müssen die richtigen Tabellen Namen eingesetzt werden.
dann sollte es funktionieren
mfg Piet
Option Explicit
'Bei Feldbezeichnung bitte die echten Namen eingeben
Const Feld1 = "Feldbezeichung1" 'z.b. Lager
Const Feld2 = "Feldbezeichung2"
Const Feld6 = "Feldbezeichung6"

Sub Feldbezeichnung_kopieren()
'Tabelle 1 + 2 als Objekt setzen
Dim Tb1 As Object, Tb2 As Object
Dim sp1, sp2, sp6, j 'Spalten-Nr
Set Tb1 = Worksheets("Tabelle1")
Set Tb2 = Worksheets("Tabelle2")
'Schleife zum ermittlen der aktuellen Spalte
'die Zeile angeben wo die Feldbezeichnung steht
For Each j In Tb1.Range("A1:F1")
If j.Value = Feld1 Then sp1 = j.Column
If j.Value = Feld2 Then sp2 = j.Column
If j.Value = Feld6 Then sp6 = j.Column
Next j
'von Tabelle1 in Tabelle2 kopieren
Tb1.Columns(sp1).Copy
Tb2.Columns(1).PasteSpecial xlValues
Tb1.Columns(sp2).Copy
Tb2.Columns(2).PasteSpecial xlValues
Tb1.Columns(sp6).Copy
Tb2.Columns(3).PasteSpecial xlValues
'CopyMode wieder ausschalten
Application.CutCopyMode = False
End Sub

With WkSh_Q.Rows(1) For iIndx = 0 To UBound(aUeberschr) Set rZelle = .Find(aUeberschr(iIndx), LookAt:=xlWhole, LookIn:=xlValues) If Not rZelle Is Nothing Then iSpalte = iSpalte + 1 'WkSh_Q.Columns(rZelle.Column).Copy WkSh_Z.Columns(iSpalte) WkSh_Z.Columns(iSpalte).Value = WkSh_Q.Columns(rZelle.Column).Value End If Next iIndx End With

Beliebteste Forumthreads (12 Monate)

bestimmte Spalte in neues Blatt kopieren

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

bestimmte Spalte in neues Blatt kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread