Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1056to1060
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

Komplette Zeilen kopieren

Komplette Zeilen kopieren
04.03.2009 15:57:59
Hans
Hallo,
ich möchte die Einträge von verschiedenen Tabellenblättern einer Excel-Mappe in ein Übersichts-Tabellenblatt derselben Mappe speichern.
Ab einer bestimmten Zeilennummer sollen die kompletten Zeilen eins Tabellenblattes bis zur letzen, beschriebenen Zeile kopiert werden, mit allen Formatierungen und Inhalten.
Es ist vorher nicht bekannt, aus wievielen einzelnen Tabellenblättern diese Übersicht erstellt
werden soll. Wie greife ich variabel auf alle Tabellenblätter mit dem Namen "Lager01, Lager02, ... Lager xx" zu?
Danke für jede Info!
Gruß
Hans

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Komplette Zeilen kopieren
04.03.2009 16:17:31
Josef
Hallo Hans,
jetzt ungetestet, aber probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Uebertragen()
  Dim objWs As Worksheet, objWsTarget As Worksheet
  Dim lngFirstRow As Long, lngLastRow As Long, lngNextRow As Long
  
  On Error GoTo ErrExit
  GMS
  
  Set objWsTarget = Sheets("Übersicht") 'Übersichtstabelle! - Anpassen!
  
  lngFirstRow = 15 'Erste Zeile die übertragen wird - Anpassen!
  
  For Each objWs In ThisWorkbook.Worksheets
    If objWs.Name Like "Lager*" Then
      lngLastRow = Application.Max(lngFirstRow, objWs.Cells(Rows.Count, 1).End(xlUp).Row)
      lngNextRow = objWsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
      objWs.Rows(lngFirstRow & ":" & lngLastRow).Copy objWsTarget.Cells(lngNextRow, 1)
    End If
  Next
  
  ErrExit:
  If Err.Number <> 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
  GMS True
  Set objWsTarget = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
  
  Static lngCalc As Long
  
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
    
  End With
  
  
End Sub

Gruß Sepp

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige