Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1392to1396
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

Arbeitslätter anderer Mappe auflisten

Arbeitslätter anderer Mappe auflisten
15.11.2014 19:05:27
Markus
Hallo zusammen,
ich steh wieder mal vor einem kleinen Problem und komm leider nicht weiter.
Der unten zu sehende Code listet alle Arbeitsblätter der aktuellen Arbeitsmappe auf, funktioniert auch einwandfrei.
Dim lngZeile As Long
With Worksheets("Datenbank")
For lngZeile = 1 To ThisWorkbook.Worksheets.Count
.Cells(lngZeile + 1, 6) = Worksheets(lngZeile).Name
Next lngZeile
End With
Ich benötige nun allerdings einen Code, der mir die Arbeitsblätter einer anderen Datei in dieser Datei fortlaufend in eine Spalte schreibt.
Da sich die Namen der beiden Dateien leider ständig ändern, muss dieser Code Variable sein.
hier mein bisheriger code:
Private Sub CommandButton1_Click() 'Sharepoint Pfad ändern
ThisWorkbook.IsAddin = False
Dim Importdaten
Dim Sname
Dim Aname
Dim lngZeile As Long
Dim Sharepoint As String
Dim Addin As Variant
Dim strSPath As String, strSDat As String, strSTab As String, strAPath As String, strADat As String, strATab As String
Dim intZ As Integer
Ti = ThisWorkbook.FullName
Importdaten = Application.GetOpenFilename
If Importdaten = False Then
TextBox1.Text = ThisWorkbook.Worksheets("Datenbank").Range("B1").Value
Else
TextBox1.Text = Importdaten 'den ganzen Pfad an das Textfeld "Pfad" schicken
ThisWorkbook.Worksheets("Datenbank").Range("B1").Value = Importdaten
si = TextBox1.Text
ThisWorkbook.Worksheets("Datenbank").Range("B4").Value = Left(si, InStrRev(si, "\") - 1)
ThisWorkbook.Worksheets("Datenbank").Range("B5").Value = Right(si, InStr(1, StrReverse(si), "\") - 1)
Sname = ThisWorkbook.Worksheets("Datenbank").Range("B5").Value
ThisWorkbook.Worksheets("Datenbank").Range("B6").Value = Left(Sname, InStrRev(Sname, ".") - 1)
Aname = ThisWorkbook.Worksheets("Datenbank").Range("B15").Value
ThisWorkbook.Worksheets("Datenbank").Range("B15").Value = Right(Ti, InStr(1, StrReverse(Ti), "\") - 1)
ThisWorkbook.Worksheets("Datenbank").Range("B14").Value = Left(Ti, InStrRev(Ti, "\") - 1)
ThisWorkbook.Worksheets("Datenbank").Range("B16").Value = Left(Aname, InStrRev(Aname, ".") - 1)
'Dim lngZeile As Long
' With Worksheets("Datenbank")
' For lngZeile = 1 To ThisWorkbook.Worksheets.Count
' .Cells(lngZeile + 1, 6) = Worksheets(lngZeile).Name
' Next lngZeile
'End With
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.Worksheets("Datenbank").Range("B1").Value
strSPath = ThisWorkbook.Worksheets("Datenbank").Range("B4").Value
strSDat = ThisWorkbook.Worksheets("Datenbank").Range("B6").Value
strSTab = ThisWorkbook.Worksheets("Datenbank").Range("B7").Value
strAPath = ThisWorkbook.Worksheets("Datenbank").Range("B14").Value
strADat = ThisWorkbook.Worksheets("Datenbank").Range("B16").Value
strATab = ThisWorkbook.Worksheets("Datenbank").Range("B17").Value
Sharepoint = strSPath & "\" & strSDat
Addin = strAPath & "\" & strADat
MsgBox Sharepoint
MsgBox Addin
With Addin
For lngZeile = 1 To Sharepoint.Worksheets.Count
Addin.Cells(lngZeile + 1, 6) = Worksheets(lngZeile).Name
Next lngZeile
End With
Application.ScreenUpdating = True
ComboBox4.Enabled = True 'Auswahl Einfügen - Start Spalte aktiviert
ThisWorkbook.Save
End If
Bei "Sharepoint.Worksheets.Count" erhalte ich allerdings immer eine Fehlermeldung - ungütiger Bezeichner.
Was mach ich falsch?
Danke und Gruß Markus

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitslätter anderer Mappe auflisten
15.11.2014 23:16:17
Markus
Guten Abend zusammen,
ich habe nach langem Probieren und mit Msgbox-Tests, meine Fehler nach und nach behoben, so dass ich nun einen funktionierenden Code habe, der genau das macht was er soll.
Falls noch jemand anders Verwednung finden sollte:

Private Sub CommandButton1_Click() 'Sharepoint Pfad ändern
ThisWorkbook.IsAddin = False
Dim Importdaten
Dim Sname
Dim Aname
Dim lngZeile As Long
Dim Sharepoint As String
Dim Addin As Variant
Dim Addin2 As String
Dim Sharepoint2 As String
Dim strSPath As String, strSDat As String, strSTab As String, strAPath As String, strADat  _
As String, strATab As String
Dim intZ As Integer
Dim nxt As String
Ti = ThisWorkbook.FullName
Importdaten = Application.GetOpenFilename
If Importdaten = False Then
TextBox1.Text = ThisWorkbook.Worksheets("Datenbank").Range("B1").Value
Else
TextBox1.Text = Importdaten 'den ganzen Pfad an das Textfeld "Pfad" schicken
ThisWorkbook.Worksheets("Datenbank").Range("B1").Value = Importdaten
si = TextBox1.Text
ThisWorkbook.Worksheets("Datenbank").Range("B4").Value = Left(si, InStrRev(si, " _
\") - 1)
ThisWorkbook.Worksheets("Datenbank").Range("B5").Value = Right(si, InStr(1,  _
StrReverse(si), "\") - 1)
Sname = ThisWorkbook.Worksheets("Datenbank").Range("B5").Value
ThisWorkbook.Worksheets("Datenbank").Range("B6").Value = Left(Sname, InStrRev( _
Sname, ".") - 1)
Aname = ThisWorkbook.Worksheets("Datenbank").Range("B15").Value
ThisWorkbook.Worksheets("Datenbank").Range("B15").Value = Right(Ti, InStr(1,  _
StrReverse(Ti), "\") - 1)
ThisWorkbook.Worksheets("Datenbank").Range("B14").Value = Left(Ti, InStrRev(Ti,  _
"\") - 1)
ThisWorkbook.Worksheets("Datenbank").Range("B16").Value = Left(Aname, InStrRev( _
Aname, ".") - 1)
'Dim lngZeile As Long
'  With Worksheets("Datenbank")
' For lngZeile = 1 To ThisWorkbook.Worksheets.Count
'  .Cells(lngZeile + 1, 6) = Worksheets(lngZeile).Name
' Next lngZeile
'End With
Application.ScreenUpdating = False
Workbooks.Open ThisWorkbook.Worksheets("Datenbank").Range("B1").Value
strSPath = ThisWorkbook.Worksheets("Datenbank").Range("B4").Value
strSDat = ThisWorkbook.Worksheets("Datenbank").Range("B5").Value
strSTab = ThisWorkbook.Worksheets("Datenbank").Range("B7").Value
strAPath = ThisWorkbook.Worksheets("Datenbank").Range("B14").Value
strADat = ThisWorkbook.Worksheets("Datenbank").Range("B15").Value
strATab = ThisWorkbook.Worksheets("Datenbank").Range("B17").Value
Sharepoint = strSPath & "\" & strSDat
Sharepoint2 = strSDat
Addin = strAPath & "\" & strADat
Addin2 = strADat
'MsgBox Sharepoint
'MsgBox Addin
With Addin
For lngZeile = 1 To ActiveWorkbook.Worksheets.Count
nxt = ActiveWorkbook.Worksheets(lngZeile).Name
Workbooks(Addin2).Activate
Worksheets(strATab).Cells(lngZeile + 1, 6) = nxt
Workbooks(Sharepoint2).Activate
Next lngZeile
Workbooks(Sharepoint2).Close savechanges:=False
End With
Application.ScreenUpdating = True
ComboBox4.Enabled = True   'Auswahl Einfügen - Start Spalte aktiviert
Dim last As Long
last = ThisWorkbook.Worksheets("Datenbank").Range("F65536").End(xlUp).Row
Me.ComboBox4.List = Range("F2:F" & last).Value
ThisWorkbook.Save
End If
End Sub
Schönen Abend noch
Gruß Markus
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige