Microsoft Excel

Herbers Excel/VBA-Archiv

Übersicht füllen | Herbers Excel-Forum


Betrifft: Übersicht füllen von: Claudia
Geschrieben am: 17.11.2009 20:33:42

Hallo zusammen,

mittels eines Makros hier aus dem Forum kopiere ich die Tabellen aus mehreren Dateien in eine Datei. Das klappt auch bestens.

Jetzt soll ich in dem Reiter ÜBersicht dieser Masterdatei Felder aus den ausgelesen Tabellen bestücken oder einlesen. Hier stehen mir Mangels Wissen und Können tausend Hürden im Weg.

- alle Tabellen (ab der 2) müssen mittels einer Schleife ausgelesen werden
- hierzu muss für jedes Tabellenblatt der Schutz aufgehoben werden ("Claudia")
- dann müssen in die Spalten D bis O im Reiter "Übersicht" die Werte aus den anderen Tabellen (die Zellangaben aus den Tabellen habe ich in Zeile 1 geschrieben. Sie sind für alle Tabellen identisch)eingetragen werden

Ich habe mal das erste Blatt als DAtei eingefügt:

https://www.herber.de/bbs/user/65987.xls

Wer kann mir bei dieser kniffligen Aufgabe helfen?

Ich sage schon einmal danke im Voraus!

Liebe Grüße
Claudia

  

Betrifft: AW: Übersicht füllen von: Josef Ehrensberger
Geschrieben am: 17.11.2009 20:56:59

Hallo Claudia,

probie mal.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub datenSammeln()
  Dim objSh As Worksheet, objShUe As Worksheet
  Dim lngLast As Long, lngRow As Long, lngCol As Long, lngLastCol As Long
  
  Set objShUe = Sheets("Übersicht")
  
  With objShUe
    lngLast = Application.Max(2, .Cells(.Rows.Count, 2).End(xlUp).Row)
    lngLastCol = Application.Max(4, .Cells(1, .Columns.Count).End(xlToLeft).Column)
    
    For lngRow = 2 To lngLast
      If SheetExist(.Cells(lngRow, 2).Text) Then
        Set objSh = Sheets(.Cells(lngRow, 2).Text)
        For lngCol = 4 To lngLastCol
          If isRange(.Cells(1, lngCol).Text) Then .Cells(lngRow, lngCol) = objSh.Range(.Cells(1, lngCol).Text)
        Next
      End If
    Next
    
  End With
  
  
  Set objShUe = Nothing
  Set objSh = Nothing
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If wks.Name = sheetName Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function

Private Function isRange(ByVal Text As String) As Boolean
  Dim rng As Range
  On Error Resume Next
  Set rng = Range(Text)
  On Error GoTo 0
  isRange = Not rng Is Nothing
  Set rng = Nothing
End Function



Gruß Sepp



  

Betrifft: AW: Übersicht füllen von: Claudia
Geschrieben am: 17.11.2009 21:04:46

Hallo Sepp,

da tut sich irgendwie nix. Kann aber auch nicht erkennen, dass hier ein Schutz entfernt wird bzw. das Kennwort eingegeben wird. Muss das nicht noch rein?

Liebe Grüße
Claudia


  

Betrifft: AW: Übersicht füllen von: Claudia
Geschrieben am: 17.11.2009 21:07:05

Falsch, es tut sich doch was.

Super, vielen vielen Dank! Ich werde es morgen auf der Arbeit dann ausführlich testen.

Liebe Grüße und schönen Abend!
Claudia


  

Betrifft: AW: Übersicht füllen von: Josef Ehrensberger
Geschrieben am: 17.11.2009 21:09:41

Hallo Claudia,

um Werte aus einer Tabelle auszulesen, braucht man den Schutz nicht aufheben.

Nach meinem Verständnis, heissen die Tabellen so, wie sie in Spalte B stehen und es werden die Zellen die in Reihe 1 benannt sind ausgelesen.


Gruß Sepp



Beiträge aus den Excel-Beispielen zum Thema "Übersicht füllen"