Microsoft Excel

Herbers Excel/VBA-Archiv

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

mehrere getrennte variable Splaten kopieren | Herbers Excel-Forum


Betrifft: mehrere getrennte variable Splaten kopieren von: DirkR
Geschrieben am: 13.02.2012 09:31:18

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

  

Betrifft: AW: mehrere getrennte variable Splaten kopieren von: Josef Ehrensberger
Geschrieben am: 13.02.2012 09:42:43


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 »



  

Betrifft: AW: mehrere getrennte variable Splaten kopieren von: DirkR
Geschrieben am: 13.02.2012 10:00:31

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


  

Betrifft: AW: mehrere getrennte variable Splaten kopieren von: DirkR
Geschrieben am: 13.02.2012 10:06:04

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


  

Betrifft: AW: mehrere getrennte variable Splaten kopieren von: Josef Ehrensberger
Geschrieben am: 13.02.2012 10:10:35


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 »



  

Betrifft: AW: mehrere getrennte variable Splaten kopieren von: DirkR
Geschrieben am: 13.02.2012 10:16:14

Hallo Sepp,

super, super!!!! :-)

Genau so! Danke!

Du hast mir (mal wieder) sehr geholfen!!!!!
Gruß DirkR


Beiträge aus den Excel-Beispielen zum Thema "mehrere getrennte variable Splaten kopieren"