Tabellenblatt Name

Daniela · 2022-01-13T14:24:18+00:00

Hallo zusammen, Ich habe eine Frage zum Thema Name vom Tabellenblatt. Ich erhalte diverse Excel-File mit unterschiedlichen Tabellenblatt-Namen (einmal kommt eine Tabelle mit dem Registername 220110-Auswertung-Q1. Das andere mal mit dem Namen 220204-Kunden-Q2 usw.) Im Folgenden Makro (ich habe nur einen kleinen Teil des Makros kopiert) habe ich bis anhin das Tebelleblatt mit Tabelle1 angegeben. Wie kann ich das ändern damit, egal wie das Tabellenblatt benannt wird, das Blatt nach dem (Name) und nicht nach dem Name eingelesen wird? Set oFS = CreateObject("Scripting.FileSystemObject") For Each oDatei In oFS.GetFolder(sDateiPfad).Files If InStrRev(oDatei.Name, "xlsx") Then sBlatt = "Tabelle1" oMe.Cells(iZeile, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("A2")) oMe.Cells(iZeile, 3) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("B2")) oMe.Cells(iZeile, 4) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C2")) oMe.Cells(iZeile, 5) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("E2")) Vielen Dank für eure Ideen. lg Daniela

Wenn ich den Punkt setzte, wird der Fehler immer noch ausgegeben.
Hier einmal mein Makro als ganzes. Eventuell habe ich da noch was übersehen.


Dim oMe As Worksheet, iZeile As Long, oDatei As Object
Dim oFS As Object, wbQuelle As Workbook, sBlatt As String
Set oMe = ThisWorkbook.ActiveSheet
Const sDateiPfad As String = "Pfad \"
iZeile = 19
Application.ScreenUpdating = False
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
If InStrRev(oDatei.Name, "xlsx") Then
sBlatt = GetSheetNames(o.Blatt.Name)(0)
oMe.Cells(iZeile, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("A2"))
oMe.Cells(iZeile, 3) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("B2"))
oMe.Cells(iZeile, 4) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C2"))
oMe.Cells(iZeile, 5) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("E2"))
oMe.Cells(iZeile, 6) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("F2"))
oMe.Cells(iZeile, 7) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("G2"))
oMe.Cells(iZeile, 8) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("H2"))
oMe.Cells(iZeile, 9) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("I2"))
oMe.Cells(iZeile, 10) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("J2"))
oMe.Cells(iZeile, 11) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("K2"))
oMe.Cells(iZeile, 12) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("L2"))
oMe.Cells(iZeile, 13) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("M2"))
oMe.Cells(iZeile, 14) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("N2"))
oMe.Cells(iZeile, 15) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("O2"))
oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, 17), Address:=sDateiPfad _
& oDatei.Name, TextToDisplay:=oDatei.Name
iZeile = iZeile + 1
End If
Next
Set oMe = Nothing: Set wbQuelle = Nothing
End Sub
Private Function GetValue(ByVal sPath As String, ByVal sFile As String, _
ByVal sSheet As String, oTarget As Object) As Variant
On Error GoTo ErrorHandler
If Right$(sPath, 1)  "\" Then sPath = sPath & "\"
GetValue = ExecuteExcel4Macro("'" & sPath & "[" & sFile & "]" & sSheet & "'!" _
& oTarget.Range("A1").Address(, , xlR1C1))
On Error GoTo ErrorHandler
If IsError(GetValue) Then
GetValue = ExecuteExcel4Macro("'" & sPath & "[" & sFile & "]" & "Feuil1" & "'!" _
& oTarget.Range("A1").Address(, , xlR1C1))
End If
Exit Function
ErrorHandler:
GetValue = CVErr(xlErrRef)
End Function

Guten Morgen
Ehrlich gesagt, weis ich nicht wie ich diesen Script an meines anpassen soll.


Option Explicit
Sub first_tabName()
Dim varTabs As Variant, strFilename As String
strFilename = "Pfad\"
varTabs = GetSheetNames(strFilename)
MsgBox varTabs(0)
End Sub
Private Function GetSheetNames(ByVal FileName As String) As Variant
'original by Bob Phillips, adapted by j.ehrensberger
Dim objADO As Object, objCAT As Object, objTAB As Object
Dim lngI As Long, intL As Integer, intP As Integer, intS As Integer
Dim strCon As String, strTab As String
Dim vntTmp() As Variant
If Mid(FileName, InStrRev(FileName, ".") + 1) = "xls" Then
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Extended Properties=Excel 8.0;" & _
"Data Source=" & FileName & ";"
ElseIf Mid(FileName, InStrRev(FileName, ".") + 1) Like "xls?" Then
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0;HDR=YES"";" _
& "Data Source=" & FileName & ";"
Else
Exit Function
End If
Set objADO = CreateObject("ADODB.Connection")
objADO.Open strCon
Set objCAT = CreateObject("ADOX.Catalog")
Set objCAT.ActiveConnection = objADO
For Each objTAB In objCAT.Tables
strTab = objTAB.Name
intL = Len(strTab)
intP = 0
intS = 1
'Worksheet name with embedded spaces enclosed by single quotes
If Left(strTab, 1) = "'" And Right(strTab, 1) = "'" Then
intP = 1
intS = 2
End If
'Worksheet names always end in the "$" character
If Mid$(strTab, intL - intP, 1) = "$" Then
Redim Preserve vntTmp(lngI)
vntTmp(lngI) = Mid$(strTab, intS, intL - (intS + intP))
lngI = lngI + 1
End If
Next objTAB
If lngI > 0 Then GetSheetNames = vntTmp
objADO.Close
Set objCAT = Nothing
Set objADO = Nothing
End Function

Forumthread: Tabellenblatt Name

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Tabellenblatt Name

Forumthread: Tabellenblatt Name

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread