Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Spalten innerhab Tabelle kopieren
#1
Hallo ihr fleissigen Excel Profi
ich habe eine umfangreiche Tabelle mit mehreren Spalten, unterteilt in 2 Hälften. Rechts sind "Masterdaten" und  und links ein für mich komprimierter "Auszug".
Das funktioniert  auch ganz gut. Wenn aber die Spaltenüberschriften der "Masterdaten" in einerandern Spalte stehen, muss ich jedesmal das Makro ändern.

Ich möchte nun, dass anstelle der Spalten Bezeichnung (Const von ="AR, .....), die Überschriften

="Vorname", "Nachname", "Geburt-Datum", "Geburt-Ort","Tod-Datum", "Tod-Ort", "Ehe-Heirat-Datum", "Ehe-Heirat-Ort", "Beruf", "Wohnort", "Wohn-Adr", "Quelle" verwenden.

Die Überschriften (Const nach ="E, .....) bleiben immer an gleicher Stelle.

Da dies mein Wissen übersteigt, wäre ich dankbar, wenn mir jemand helfen würde.
Mit freundlichen Gerüssen
Martin


Angehängte Dateien
.xlsm   Test kopieren ohne Spaltenkopf.xlsm (Größe: 142,42 KB / Downloads: 7)
Antwortento top
#2
Hallo Namensvetter,
nach einigen Korrekturen und Erweiterungen der Listen und der Änderung der Überschrfit in den Masterdaten zu Vor - name und Nach - name bin ich zu folgendem Ergebnis gekommen:
PHP-Code:
Sub Spalten_kopieren()
Dim lz01&, i&, ersteZeile
Const von "Stamm,GEN 1,Vor - name,Nach - name,Geburt - Datum,Geburt - Ort,Ehe - Heirat - Datum,Ehe - Heirat - Ort,Tod - Datum,Tod - Ort,Wohnort - Adresse,Wohnort - Ort,Beruf,Quelle"
Const nach "D,E,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL"
Dim aVonaNach
  ersteZeile 
7
  aVon 
Split(von",")
  With Sheets(1)
    For i& = LBound(aVonTo UBound(aVon)
      aVon(i&) = Val(.Rows(ersteZeile 1).Find(what:=aVon(i&), lookat:=xlWhole).Column)
    Next i&
    aNach Split(nach",")
    lz01 Range("BD" Cells.Rows.Count).End(xlUp).Row
    
For i& = LBound(aVonTo UBound(aVon)
      .Range(.Cells(ersteZeileVal(aVon(i&))), .Cells(lz01&, Val(aVon(i&)))).Copy Destination:=.Range(aNach(i) & ersteZeile)
    Next
  End With
End Sub 
Ob das so richtig ist, kannst nur Du rausfinden.
Gruß der (auch Martin) AlteDresdner
Antwortento top
#3
Hallo AlterDresdner (Martin)
98 für das abgeänderte Makro.
Leider bringt es mir eine Fehlermeldung.

aVon(i&) = Val(.Rows(ersteZeile - 1).Find(what:=aVon(i&), lookat:=xlWhole).Column)

Mein Wissen reicht nicht, diesen Bug zu beheben.
Wäre froh, wenn du dies für mich bereinigen würdest
Gruss Martin
Antwortento top
#4
Hallo ihr fleissigen Helfer,
habe nach einigen Versuchen ein lauffähiges Makro hinbekomme.
Der Debugg Fehler entstand durch nicht korrekte Überschriften (Makro zu Tabelle).
Es kopiert die Spalten korrekt bis auf die Überschrift "Beruf". Da da will es nicht kopieren.
Könnte mal jemand drüberschauen und ein Typ geben, was ich falsch mache oder ändern muss.
Mit dankbaren Grüssen
Martin


Angehängte Dateien
.xlsm   Spalten mit Überschriften kopieren.xlsm (Größe: 255,97 KB / Downloads: 3)
Antwortento top
#5
Hallo Martin,
der Fehler besteht darin, dass die Überschrift Beruf schon im Auszug vorhanden ist, damit findet das ...Find  auch diese Spalte.
Entweder setzt Du in den Masterdaten eindeutige Überschriften, die nicht im Auszug vorkommen, und sucht dann auch nach denen (z.B. Beruf->Beruf_)
oder Du schreibst im Code
PHP-Code:
    For i& = LBound(aVonTo UBound(aVon)
      aVon(i&) = Val(.Rows(ersteZeile 1).Find(after:=.Cells(ersteZeile 141), what:=aVon(i&), lookat:=xlWhole).Column
Das After:=... legt fest, das erst ab Spalte 41 gesucht wird.
Dann dürfen auch doppelte Überschriften Master und Auszug vorkommen...
Gruß der AlteDresdner (Win10, Off2010)
Antwortento top
#6
Hallo AlterDresdner (Martin)
danke für deine Erklärung und den änderungs Vorschlag.
Jetzt funktioniert es wie gewünscht.
Danke, dass du geholfen hast. Das ist 35
Eine schöne Woche wüscht dir
Martin
Antwortento top
#7
Hallo AlterDresdner (Martin)
wenn eine Überschrift (ZB. "Stamm") nicht vorkommt, bringt das einen Debugfehler.
Wäre es möglich, dass dieser Fehler abgefangen werden kann.
Zum Beispiel, wenn "Stamm" nicht vorhanden ist, überspringen und weiter mit nächster Überschrift.

Frage mich, ob es für mein Makro eine bessere Lösung gibt? Wenn ja, wie müsste das Makro aussehen?
Wäre es eventuell nicht besser, wenn man alles auftrennen würde?
Zum Beispiel:
wenn Überschrift "Stamm" vorhanden ist, kopiere die Daten nach Spalte "D", wenn Überschrift fehlt, weiter mit Überschrift "Vornamen" usw.
Danke für weitere Hilfe und ein schöner Sonnabend wünscht
Martin
Antwortento top
#8
Hallo Martin,
die Fehlerumgehung ist im folgenden drin (Option base 1 ist wichtig!):
PHP-Code:
Option Explicit
Option Base 1
Sub Spalten_kopieren
()
Dim lz01&, i&, ersteZeile
Const von "Stamm,Vor - name,Nach - name,Geburt - Datum,Geburt - Ort,Ehe - Heirat - Datum,Ehe - Heirat - Ort,Tod - Datum,Tod - Ort,Wohnort - Ort,Wohn - Adresse,Beruf,Notiz,Quelle 2"
Const nach "D,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM"
Dim aVonaNachaTempaTempnachanzCopy As Longerg
  ersteZeile 
7
  aTemp 
Split(von",")
  aTempnach Split(nach",")
  ReDim aVon(1)
  ReDim aNach(1)
  anzCopy 0
  With Sheets
(1)
    For i& = LBound(aTempTo UBound(aTemp)
      Set erg = .Rows(ersteZeile 1).Find(after:=.Cells(ersteZeile 141), what:=aTemp(i&), lookat:=xlWhole)
      If Not erg Is Nothing Then
        anzCopy 
anzCopy 1
        
If anzCopy UBound(aVonThen
          ReDim Preserve aVon
(anzCopy)
          ReDim Preserve aNach(anzCopy)
        End If
        aVon(anzCopy) = Val(erg.Column)
        aNach(anzCopy) = aTempnach(i&)
      End If
    Next i&
    lz01 Range("BD" Cells.Rows.Count).End(xlUp).Row
    
For i& = 1 To anzCopy
      
.Range(.Cells(ersteZeileVal(aVon(i&))), .Cells(lz01&, Val(aVon(i&)))).Copy Destination:=.Range(aNach(i) & ersteZeile)
    Next
  End With
End Sub 
Es wird dann halt nur das kopiert, was da ist.
Ob das Ganze der Weisheit letzter Schluß ist? Das Makro wäre ganz überflüssig, wenn man die Aufteilung Stammdaten-Auszug wegläßt und halt die (Auszug-) Daten vorn anordnet und den Rest weiter rechts.
Gruß der AlteDresdner (Win10, Off2010)
Antwortento top
#9
Oder:

PHP-Code:
Sub M_snb()
  sn Cells(61).CurrentRegion
  sp 
Cells(143).CurrentRegion
  
  
For jj 4 To UBound(sn2)
      If jj Or jj 26 Then
        
For 2 To UBound(sn)
          sp(jIIf(jj 6jj 3Choose(jj 25131417162425194443413447))) = sn(jjj)
        Next
      End 
If
    Next

   Cells
(143).CurrentRegion=sp
End Sub 

Aber...., wenn das Arbeitsbaltt besser strukturiert ist braucht man diese doppelte Eingabe weder VBA nicht mehr.
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antwortento top
#10
Hallo AlteDresdner (Martin),
98 für die Anpassung. Funktioniert  35
 
Mit freundlichen Grüssen
Martin

PS: Betreff Darstellung, hättest du ein Vorschlag wie es besser wäre?

Guten Abend snb,
98 für das Makro. Werde es mal testen und versuchen, zu verstehen, wie das funktioniert.
Mit dankbaren Grüssen
Martin

PS: "wenn das Arbeitsbaltt besser strukturiert ist braucht man diese doppelte Eingabe weder VBA nicht mehr."
      Bin für jeden Vorschlag dankbar.
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste