Microsoft Excel

Herbers Excel/VBA-Archiv

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

Arbeitslätter anderer Mappe auflisten

Betrifft: Arbeitslätter anderer Mappe auflisten von: Markus
Geschrieben am: 15.11.2014 19:05:27

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

  

Betrifft: AW: Arbeitslätter anderer Mappe auflisten von: Markus
Geschrieben am: 15.11.2014 23:16:17

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


 

Beiträge aus den Excel-Beispielen zum Thema "Arbeitslätter anderer Mappe auflisten"