Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Mehrere Spalten von einer Tabelle kopieren | Herbers Excel-Forum

• Mehrere Spalten von einer Tabelle kopieren von Ben Holi vom 21.01.2010 17:39:22
• AW: Mehrere Spalten von einer Tabelle kopieren - von fcs am 24.01.2010 17:34:12
  • AW: Mehrere Spalten von einer Tabelle kopieren - von Ben am 24.01.2010 18:08:50

Betrifft: Mehrere Spalten von einer Tabelle kopieren von: Ben Holi
Geschrieben am: 21.01.2010 17:39:22

Hallo Excel Experten,

ich verzweifel an dem Versuch aus einer Tabelle Spalten in eine andere Tabelle zu kopieren!

Grundsätzlich sind beide Tabellen identisch (gleiche wks Anzahl, Grunddaten usw), jedoch soll in der ersten Tabelle ab Tabellenblatt 4 in Spalte A Änderungen vorgenommen werden, dort stehen Bezeichnungen also nur Text. Die zweite Tabelle ist gleich, nur das die Spalte A unbeschrieben ist und hier sollen jetzt die Einträge aus der ersten Tabelle rein.
Problem dabei der Tabellenname soll veränderbar sein und es handelt sich um viele Blätter (Spalte A von wks 4 bis 41)

über diesen Code will ich die Datei aussuchen in welche die Spalten A der aktuellen Datei kopiert werden sollen:

ActiveWorkbook.RunAutoMacros xlAutoActivate

Dim i As Integer
Dim DatOP As Variant
Dim n As Long
Dim Range As Range

i = 0
DatOP = Application.GetOpenFilename("Excel-dateien(*.xlsm),*xls,CSV(*.csv),*csv", _
MultiSelect:=True)
If IsArray(DatOP) Then
For i = LBound(DatOP) To UBound(DatOP)
Workbooks.Open DatOP(i)
Next i
End If

allerdings fällt es mir jetzt schwer auszudrücken wie kopiert werden soll?!

Bin dankbar für jegliche Hilfe!

Betrifft: AW: Mehrere Spalten von einer Tabelle kopieren von: fcs
Geschrieben am: 24.01.2010 17:34:12

Hallo Ben Holi,

hier muss du mit Objekten für die Quelle und die Ziele arbeiten, damit du Excel mitteilen kannst, was, wo, wann passieren soll.

Gruß
Franz

Sub Test()
  Dim wbQuelle As Workbook, wksQuelle As Worksheet, rQuelle As Range
  Dim wbZiel As Workbook, wksZiel As Worksheet
  Dim i As Integer
  Dim DatOP As Variant
  Dim n As Long
  Dim Range As Range
  
  'Warum sollen hier die Ereignismakros gestartet werden, schau mal in der _
    VBA-Hilfe unter "RunAutoMacros" wie man das neuerdings löst.
  ActiveWorkbook.RunAutoMacros xlAutoActivate
  
  i = 0
  DatOP = Application.GetOpenFilename( _
    Filefilter:="Excel-dateien(*.xlsm;*.xls;*.CSV),*.xlsm;*.xls;*.CSV", _
    Title:="Datei(en) auswählen, deren Spalte A mit Daten gefüllt werden soll", _
    MultiSelect:=True)
  If IsArray(DatOP) Then
    Set wbQuelle = ActiveWorkbook
    Application.ScreenUpdating = False
    For i = LBound(DatOP) To UBound(DatOP)
      Application.StatusBar = "Datei " & i & " von " & UBound(DatOP) & " wird bearbeitet"
      Set wbZiel = Workbooks.Open(DatOP(i))
      'Blätter in Quelle abarbeiten
      For n = 4 To wbQuelle.Worksheets.Count
        If n <= wbZiel.Worksheets.Count Then
          'Tabellenblatt-Objekte setzen
          Set wksQuelle = wbQuelle.Worksheets(n)
          Set wksZiel = wbZiel.Worksheets(n)
          'Datenbereich ermitteln in Spalte A des Quelltabellenblattes
          With wksQuelle
            Set rQuelle = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
          End With
          'Daten in Zieltabelle in den gleichen Bereich kopieren
          rQuelle.Copy Destination:=wksZiel.Range(rQuelle.Address)
        End If
      Next n
      If wbQuelle.Worksheets.Count <> wbZiel.Worksheets.Count Then
        Application.ScreenUpdating = True
        MsgBox "Die Anzahl der Tabellenblätter in """ & wbQuelle.Name & _
          """ und """ & wbZiel.Name & """ ist nicht identisch.", _
          vbInformation + vbOKOnly, "K O P I E R E N   -   Spalte A"
        Application.ScreenUpdating = False
      End If
      'ausgefüllte Datei speichern
      wbZiel.Save
      'Wenn viele Dateien ausgewählt werden (mehr als ca. 5), dann sollte jede _
        ausgefüllte Datei gleich wieder geschlossen werden.
'      wbZiel.Close savechanges:=True
      Set wbZiel = Nothing
      Set wksZiel = Nothing
      Set rQuelle = Nothing
    Next i
    Application.StatusBar = False
    Set wksZiel = Nothing
    Set wbQuelle = Nothing
  End If
  Set DatOP = Nothing
  Application.ScreenUpdating = True
End Sub

Betrifft: AW: Mehrere Spalten von einer Tabelle kopieren von: Ben
Geschrieben am: 24.01.2010 18:08:50


Danke Franz,

ich hatte inzwischen weitergearbeitet und ebenfalls rausbekommen, dass ich mit Objekten arbeiten muss! Ich habe mit deinem Code meinen modifiziert und es funktioniert jetzt wie gewünscht!

Vielen Dank!

Beiträge aus den Excel-Beispielen zum Thema "Mehrere Spalten von einer Tabelle kopieren"