Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1248to1252
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

mehrere getrennte variable Splaten kopieren

mehrere getrennte variable Splaten kopieren
DirkR
Hallo Excel-Experten!!!
Ich sehe den Wald vor lauter Bäumen nicht!
Ich habe folgendes Problem und bitte um Mithilfe!
Ich möchte in einer Tabelle mehrere, getrennte, variable Bereiche kopieren.
Konkret sind das die Spalten B, C, H, J, K, L, M, O, S, DR und DS
Immer von Zeile 21 bis zur Zeile mit dem letzten Eintrag in Spalte B
Gibt es eine Elegante Möglichkeit direkt alle zu kopieren. Jeden für sich zu kopieren wäre nicht das Problem.
Gruß DirkR

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: mehrere getrennte variable Splaten kopieren
13.02.2012 09:42:43
Josef

Hallo Dirk,
Sub copyColumns()
  Dim rngCopy As Range
  Dim vntColumns As Variant
  Dim lngFirst As Long, lngLast As Long, lngIndex As Long
  
  vntColumns = Array(2, 3, 8, 10, 11, 12, 13, 15, 19, 122, 123)
  lngFirst = 21
  
  With ActiveSheet
    lngLast = Application.Max(lngFirst, Cells(.Rows.Count, vntColumns(0)).End(xlUp).Row)
    For lngIndex = 0 To UBound(vntColumns)
      If lngIndex = 0 Then
        Set rngCopy = .Range(.Cells(lngFirst, vntColumns(lngIndex)), _
          .Cells(lngLast, vntColumns(lngIndex)))
      Else
        Set rngCopy = Union(rngCopy, .Range(.Cells(lngFirst, vntColumns(lngIndex)), _
          .Cells(lngLast, vntColumns(lngIndex))))
      End If
    Next
  End With
  
  rngCopy.Copy Sheets("Tabelle3").Range("A1")
  
  Set rngCopy = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: mehrere getrennte variable Splaten kopieren
13.02.2012 10:00:31
DirkR
Hallo Sepp,
danke für die schnelle Antwort.
Das sieht schon ganz gut aus.
Wie muss der Code abgeändert werden, damit nur Werte kopiert werden?
Und ich möchte gerne den Code durch folgendes Ereignis im Tabellenblatt "Übersicht Kontrollgegenstände"starten:
Private Sub Worksheet_Activate()
Die Daten sollen dann im Tabellenblatt "Datenbank" kopiert werden und die Werte sollen ab Zelle B3 ins Tabellenblatt "Übersicht Kontrollgegenstände" eingfügt werden.
Gruß DirkR
AW: mehrere getrennte variable Splaten kopieren
13.02.2012 10:06:04
DirkR
Hallo Sepp,
ich habe folgende ausprobiert:
(Im Modul Tabellenblatt "Übersicht Kontrollgegenstände")
Private Sub Worksheet_Activate()
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
Call copyColumns
objShell.Popup "Alle aktuellen Daten zu den Kontrollgegenständen wurden in dieses Tabellenblatt  _
kopiert!", 1, " Hinweis!!!"
Set objShell = Nothing
End Sub
Sub copyColumns()
Dim rngCopy As Range
Dim vntColumns As Variant
Dim lngFirst As Long, lngLast As Long, lngIndex As Long
With Sheets("Datenbank")
For lngLast = 1020 To 21 Step -1
If Sheets("Datenbank").Cells(lngLast, 8).Value "" Then Exit For
Next lngLast
MsgBox lngLast
vntColumns = Array(2, 3, 8, 10, 11, 12, 13, 15, 19, 122, 123)
lngFirst = 21
For lngIndex = 0 To UBound(vntColumns)
If lngIndex = 0 Then
Set rngCopy = .Range(.Cells(lngFirst, vntColumns(lngIndex)), _
.Cells(lngLast, vntColumns(lngIndex)))
Else
Set rngCopy = Union(rngCopy, .Range(.Cells(lngFirst, vntColumns(lngIndex)), _
.Cells(lngLast, vntColumns(lngIndex))))
End If
Next
End With
Range("B3").PasteSpecial Paste:=xlPasteValues
End Sub Leider bekomme ich dauernd eine Fehlermeldung!?!?!
Gruß Dirk R
Anzeige
AW: mehrere getrennte variable Splaten kopieren
13.02.2012 10:10:35
Josef

Hallo Dirk,
ins Modul von "Übersicht Kontrollgegenstände".
' **********************************************************************
' Modul: Tabelle3 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Activate()
  Dim rngCopy As Range
  Dim vntColumns As Variant
  Dim lngFirst As Long, lngLast As Long, lngIndex As Long
  
  vntColumns = Array(2, 3, 8, 10, 11, 12, 13, 15, 19, 122, 123)
  lngFirst = 21
  
  With Sheets("Datenbank")
    lngLast = Application.Max(lngFirst, .Cells(.Rows.Count, vntColumns(0)).End(xlUp).Row)
    For lngIndex = 0 To UBound(vntColumns)
      If lngIndex = 0 Then
        Set rngCopy = .Range(.Cells(lngFirst, vntColumns(lngIndex)), _
          .Cells(lngLast, vntColumns(lngIndex)))
      Else
        Set rngCopy = Union(rngCopy, .Range(.Cells(lngFirst, vntColumns(lngIndex)), _
          .Cells(lngLast, vntColumns(lngIndex))))
      End If
    Next
  End With
  
  rngCopy.Copy
  Me.Range("A1").PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  
  Set rngCopy = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: mehrere getrennte variable Splaten kopieren
13.02.2012 10:16:14
DirkR
Hallo Sepp,
super, super!!!! :-)
Genau so! Danke!
Du hast mir (mal wieder) sehr geholfen!!!!!
Gruß DirkR

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige