füge Daten an falsche Stelle ein

Public Sub SpaltenKopieren() Dim lastColumn As Integer Dim wbFrom As Workbook Dim wsFrom As Worksheet Dim wsTo As Worksheet Dim i As Integer Application.ScreenUpdating = False 'Sheet, in das die Daten eingefügt werden Set wsTo = ActiveWorkbook.Sheets("Tabelle1") 'wsTo.Cells.Clear 'Datendatei öffnen und letzte verwendete Spalte ermitteln Set wbFrom = ActiveWorkbook Set wsFrom = wbFrom.Sheets("Input1") lastColumn = Sheets("Input1").Cells(10, Columns.Count).End(xlToLeft).Column 'alle verwendeten Spalten durchlaufen und überprüfen, 'ob Wert in erster Zelle einem gesuchten Wert entspricht 'wenn ja, Spalte kopieren For i = 1 To lastColumn ' die Zahl ist die spalte Select Case wsFrom.Cells(10, i).Text Case "Nummer" wsFrom.Columns(i).Copy wsTo.Columns(1).PasteSpecial xlPasteAll Case "Bezeichnung" wsFrom.Columns(i).Copy wsTo.Columns(2).PasteSpecial xlPasteAll Case "Geprüft" wsFrom.Columns(i).Copy wsTo.Columns(3).PasteSpecial xlPasteAll Case "Offen" wsFrom.Columns(i).Copy wsTo.Columns(4).PasteSpecial xlPasteAll Case "Erledigt" wsFrom.Columns(i).Copy wsTo.Columns(5).PasteSpecial xlPasteAll Case "In Bearbeitung" wsFrom.Columns(i).Copy wsTo.Columns(6).PasteSpecial xlPasteAll Case "Verkauf" wsFrom.Columns(i).Copy wsTo.Columns(7).PasteSpecial xlPasteAll End Select Next Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Case "Nummer" wsFrom.Columns(i).Copy wsTo.Cells(2,2).PasteSpecial xlPasteAll Case "Bezeichnung" wsFrom.Columns(i).Copy wsTo.Cells(2,3).PasteSpecial xlPasteAll Case "Geprüft" wsFrom.Columns(i).Copy wsTo.Cells(2,4).PasteSpecial xlPasteAll Case "Offen" wsFrom.Columns(i).Copy wsTo.Cells(2,5).PasteSpecial xlPasteAll Case "Erledigt" wsFrom.Columns(i).Copy wsTo.Cells(2,6).PasteSpecial xlPasteAll Case "In Bearbeitung" wsFrom.Columns(i).Copy wsTo.Cells(2,7).PasteSpecial xlPasteAll Case "Verkauf" wsFrom.Columns(i).Copy wsTo.Cells(2,8).PasteSpecial xlPasteAll

Hallo Thomas,
mit oder ohne Überschriften nach Tabelle1 übertragen?
Was soll geschehen, wenn in Tabelle1 schon Daten drinstehen?
Bis dahin:

Public Sub SpaltenKopieren()
Dim lastColumn As Integer
Dim wbFrom As Workbook
Dim wsFrom As Worksheet
Dim wsTo As Worksheet
Dim i As Integer
Application.ScreenUpdating = False
'Sheet, in das die Daten eingefügt werden
Set wsTo = ActiveWorkbook.Sheets("Tabelle1")
'wsTo.Cells.Clear
'Datendatei öffnen und letzte verwendete Spalte ermitteln
Set wbFrom = ActiveWorkbook
Set wsFrom = wbFrom.Sheets("Input1")
lastColumn = Sheets("Input1").Cells(10, Columns.Count).End(xlToLeft).Column
'alle verwendeten Spalten durchlaufen und überprüfen,
'ob Wert in erster Zelle einem gesuchten Wert entspricht
'wenn ja, Spalte kopieren
For i = 1 To lastColumn      '  die Zahl ist die spalte
Select Case wsFrom.Cells(10, i).Text
Case "Nummer"
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(1).Cells(1, 1).PasteSpecial xlPasteAll
Case "Bezeichnung"
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(2).Cells(1, 1).PasteSpecial xlPasteAll
Case "Geprüft"
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(3).Cells(1, 1).PasteSpecial xlPasteAll
Case "Offen"
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(4).Cells(1, 1).PasteSpecial xlPasteAll
Case "Erledigt"
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(5).Cells(1, 1).PasteSpecial xlPasteAll
Case "In Bearbeitung"
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(6).Cells(1, 1).PasteSpecial xlPasteAll
Case "Verkauf"
wsFrom.Columns(i).Cells(10, 1).Resize(wsFrom.Cells(10, 1).End(xlDown).Row - 9).Copy
wsTo.Columns(7).Cells(1, 1).PasteSpecial xlPasteAll
End Select
Next
Application.ScreenUpdating = True
End Sub

Gruß Gerd

hallo Gerd,
vielen dank schon mal für deine hilfe ist ja doch viel mehr arbeit als ich gedacht habe. Ich und mein dummes select.
Die überschriften benötige ich dein Makro läuft super ich kann die Daten jetzt da hin machen wo ich Sie benötige.
Die alten Daten müssen immer gelöscht werden.
Oh Oh deine Fragen bringen mich auf eine schlimme idee. Wenn nur eine Spalte der gesuchten nicht da ist darf das Macro garnichts machen.Sonst rechnen meine Formeln dahinter falsch. Oh Oh wie geht das denn. Ist es möglich irgend eine Zelle ausserhalb des bereichs z.B. Z2 zu prüfen ob ob da ein x drin steht. Und nur dann soll das Macro ausgeführt werden? Das X bekomme ich bestimmt mit irgendeiner eine formel hin. Oder geht es auch anders.
hab vielen dank für die viele arbeit
liebe grüsse thomas

Beliebteste Forumthreads (12 Monate)

füge Daten an falsche Stelle ein

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread