Daten auslesen & Übertragen
26.07.2014 05:41:42
Bernd
Wunderschönen guten morgen liebe Excelgemeinde!
Bin da wieder mal an meine Grenzen gestossen und Bitte um Eure Hilfe.
Ich habe eine Arbeitsmappe mit knapp über 500 Tabellenblätter die alle exakt gleich aufgebaut sind.
SERGE hat mir damit bereits geholfen wo ich nachstehenden VBA Code erhalten habe:
~
Sub Name()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim WS As Worksheet
Dim X As Integer
Dim Y As Integer
Set WS = ActiveSheet
For X = 1 To ActiveWorkbook.Worksheets.Count
For Y = X To ActiveWorkbook.Worksheets.Count
If Worksheets(Y).Name < Worksheets(X).Name Then
Worksheets(Y).Move Before:=Worksheets(X)
End If
Next Y
Next X
WS.Activate
Set WS = Nothing
Dim i As Integer
For i = 1 To Worksheets.Count
Cells(i, 1) = Sheets(i).Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:= _
"'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
Next 'i
Columns("A:A").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.GoTo Reference:="R3C1"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Dim WsShell, intText As Integer
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("Inhalt neu aufgelistet - - - Hinweis wird automatisch nach 3 _
Sekunden geschlossen!!!", 3, "Huhu ...")
End Sub
Nun zu meinen Anliegen:
Ist es möglich den Code so zu verändern dass bei den aufgelisteten Blattnamen zusätzlich die Inhalte des Tabellenblattes der Zellen B2 und S2 mit aufgelistet wird?
Hoffe ich habe es Verständlich erklärt, danke schon mal vorab für jegliche Hilfe und wünsche einen sonnigen ruhigen Samstag.
lg Bernd