füge Daten an falsche Stelle ein

Bild

Betrifft: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 11:09:25

Hallo Excelfreunde,
ich möchte gern bestimmte Spalten anhand der Überschrift kopieren.
Dazu habe ich das untenstehende Makro umgebaut. Das kopieren klappt schon mal ganz gut. Nur leider komme ich mit dem einfügen nicht klar
Zur Zeit ist es so das die Überschrift in der Quelle in Zeile 10 steht und das Makro kopiert die Daten in die Zieltabelle ab Zelle A10. Ich benötige aber die Daten aber ab zelle B2.
kann sich dies mal bitte jemand anschauen und mir ein tipp geben?
liebe grüsse thomas
https://www.herber.de/bbs/user/99834.xls

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

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Werner
Geschrieben am: 26.08.2015 11:18:36
Hallo Thomas,
vielleicht so??

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
Ungetestet.
Gruß Werner

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 11:42:16
Hallo Werner,
vielen dank das du dir dies mal anschaust.
Leider Funktioniert es so nicht. Ich bekomme eine Meldung das das der bereich vom kopieren zum einfügen unterschiedliche grösse und formen haben.
hast du noch eine Idee?
Liebe grüsse thomas

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 11:49:47
Hallo,
bestimmt liegt es an mein dummes select in der zeile Select Case wsFrom.Cells(10, i).Text
aber ich weiss es leider nicht besser
liebe grüsse thomas

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 11:49:48
Hallo,
bestimmt liegt es an mein dummes select in der zeile Select Case wsFrom.Cells(10, i).Text
aber ich weiss es leider nicht besser
liebe grüsse thomas

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 11:49:49
Hallo,
bestimmt liegt es an mein dummes select in der zeile Select Case wsFrom.Cells(10, i).Text
aber ich weiss es leider nicht besser
liebe grüsse thomas

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 11:59:39
hallo,
ups die beispieldatei hat ein klein Fehler die daten sollen natürlich in Tabelle1 ab zelle B2 landen.
Diese bemerkung " die Daten sollen ab hier landen" sollte in Tabelle1 stehen.
sorry
liebe grüsse thomas

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Gerd L
Geschrieben am: 26.08.2015 12:06:03
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

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 12:36:08
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

Bild

Betrifft: AW: füge Daten an falsche Stelle ein
von: Thomas
Geschrieben am: 26.08.2015 13:41:15
Hallo,
könnte dies hier
If Application.WorksheetFunction.CountIf(Sheets("Input1").Range("a10:r10"), "Nummer") kleiner 0 Then),
ein ansatz sein? Ich weis nur nicht wie ich hier die anderen Kriterien unterbekomme.
If Application.WorksheetFunction.CountIf(Sheets("Input1",).Range("a10:r10"),"Nummer", "Bezeichnung, unsw.) kleiner 0 Then ),
das kleiner zeichen geht leider im Forum nicht deshalb habe ich es als wort geschrieben.
funktioniert leider nicht
liebe grüsse thomas

Bild

Betrifft: Lösung gefunden besten dank
von: Thomas
Geschrieben am: 26.08.2015 23:42:50
Hallo excelfreunde,
ich glaub ich kann dies schliessen.
Es funktioniert mit
With Worksheets("Auswertung Allgemein").Range("a10:za10")
'Erste Suche
Set S1 = .Find(Suchwert1, LookIn:=xlValues)
If Not S1 Is Nothing Then
Set S2 = .Find(Suchwert2, LookIn:=xlValues)
If Not S2 Is Nothing Then
Set S3 = .Find(Suchwert3, LookIn:=xlValues)
If Not S3 Is Nothing Then
Set S4 = .Find(Suchwert4, LookIn:=xlValues)
If Not S4 Is Nothing Then
liebe grüsse thomas

 Bild

Beiträge aus den Excel-Beispielen zum Thema "füge Daten an falsche Stelle ein"