Makro mit ODER Befehl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Mine,
versuch es so:

Option Explicit
Sub GunTest()
Dim strFile As String, lngIndex As Long, lngC As Long, lngCol As Long
Dim strRef  As Variant
Dim vBlatt  As Variant
Dim iIndx   As Integer
'# ANPASSEN #
Const cstrPath As String = "D:\Alex\Gun Test" 'Verzeichnis
'Const cstrTab As String = "Sheet_tomo" 'Tabellenname
strRef = Array("B4", "B5", "B2", "B1", "I1", "B3", "B9", "B10", "F9", "F11", "I11", "F13", "I17", "D16", "E16", "I20") 'Zelladressen
'############
vBlatt = Array("sheet_tomo", "sheet_all")
For iIndx = LBound(vBlatt) To UBound(vBlatt)
For lngC = 0 To UBound(strRef)
  lngIndex = 0
  lngCol = lngCol + 1
  Do
    strFile = "1" & IIf(lngIndex > 0, " (" & CStr(lngIndex) & ")", "") & ".xls"
    If Dir(cstrPath & IIf(Right(cstrPath, 1) <> "\", "\", "") & strFile) <> "" Then
      Cells(lngIndex + 2, lngCol).Formula = "='" & cstrPath & IIf(Right(cstrPath, 1) "\", "\[", "[") & _
strFile & "]" & vBlatt(iIndx) & "'!" & strRef(lngC)
    Else
      Exit Do
    End If
    lngIndex = lngIndex + 1
  Loop
Next lngC
Next iIndx
End Sub
Gruß Peter
Testen geht wegen fehlender Mustermappe nicht!

Hallo Mine,
in Deiner ersten Anfrage hießen die Blätter noch ganz anders und auch die Zellen waren ganz andere - aber sei es drum:
Hier mein Vorschlag:

Option Explicit
Public Sub GunTest()
Dim strFile   As String
Dim lngIndex  As Long
Dim lngC      As Long
Dim lngCol    As Long
Dim strRef    As Variant
Dim vBlatt    As Variant
Dim iIndx     As Integer
'# ANPASSEN #
Const cstrPath As String = "D:\Alex\Gun Test" 'Verzeichnis
'Const cstrTab As String = "Sheet_tomo" 'Tabellenname
   strRef = Array("A1", "B1", "C1", "D1") 'Zelladressen
'############
   vBlatt = Array("Test1", "Test2")
   For iIndx = LBound(vBlatt) To UBound(vBlatt)
      For lngC = 0 To UBound(strRef)
         lngIndex = 0
         lngCol = lngCol + 1
         Do
            strFile = "1" & IIf(lngIndex > 0, " (" & CStr(lngIndex) & ")", "") & ".xls"
            If Dir(cstrPath & IIf(Right(cstrPath, 1) <> "\", "\", "") & strFile) <> "" Then
               Cells(lngIndex + 2, lngCol).Formula = _
                  "='" & cstrPath & IIf(Right(cstrPath, 1) "\", "\[", "[") & _
strFile & "]" & vBlatt(iIndx) & "'!" & strRef(lngC)
             Else
               Exit Do
            End If
            lngIndex = lngIndex + 1
         Loop
      Next lngC
   Next iIndx
End Sub
Gruß Peter

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro mit ODER Befehl

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread