Hilfe bei Code erweitern

Sub AusGeschlossenerDateiLesen() Dim sTxt As String, sBereich1 As String, sBereich2 As String, sBereich3 As String, sBereich4 As String, sAktuell As String Dim rng As Range, rngCell As Range sBereich1 = "a9:o9" 'sBereich2 = "c16:z62" 'sBereich3 = "a63:o84" 'sBereich4 = "w103:ak220" sAktuell = Range("d1").Value 'Sheetname (ActiveSheet) sTxt = "'" & Range("B1").Value ' Path sTxt = sTxt & "[" & Range("B2").Value & "]" 'SheetName sTxt = sTxt & sAktuell & "'!" sTxt = sTxt & sBereich1 Set rng = Worksheets(sAktuell).Range(sBereich1) rng.Cells(1).Formula = "=if(" & sTxt & "="""",""""," & sTxt & ")" rng.Cells(1).Copy rng rng.Value = rng.Value rng.Columns.AutoFit 'rng.Parent.Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub AusGeschlossenerDateiLesen() Dim sTxt As String, sBereich1 As String, sBereich2 As String, sBereich3 As String, sBereich4 As String, sAktuell As String Dim rng As Range, rngCell As Range Dim i sBereich1 = "a9:o9" sBereich2 = "c16:z62" sBereich3 = "a63:o84" sBereich4 = "w103:ak220" for i = 1 to 4 sAktuell = Range("d1").Value 'Sheetname (ActiveSheet) sTxt = "'" & Range("B1").Value ' Path sTxt = sTxt & "[" & Range("B2").Value & "]" 'SheetName sTxt = sTxt & sAktuell & "'!" sTxt = sTxt & "sBereich" & i Set rng = Worksheets(sAktuell).Range("sBereich" & i) rng.Cells(1).Formula = "=if(" & sTxt & "="""",""""," & sTxt & ")" rng.Cells(1).Copy rng rng.Value = rng.Value rng.Columns.AutoFit 'rng.Parent.Select next i End Sub

Hallo
damit funktioniert es, und ich denke trotzallem ausreichend schnell


Sub AusGeschlossenerDateiLesen()
Dim sTxt As String, sBereich1 As String, sBereich2 As String, sBereich3 As String, sBereich4 As String, sAktuell As String
Dim rng As Range, rngCell As Range
Dim i
sBereich1 = "a9:o9"
sBereich2 = "c16:z62"
sBereich3 = "a63:o84"
sBereich4 = "w103:ak220"
sAktuell = Range("d1").Value 'Sheetname (ActiveSheet)
sTxt = "'" & Range("B1").Value ' Path
sTxt = sTxt & "[" & Range("B2").Value & "]" 'SheetName
sTxt = sTxt & sAktuell & "'!"
sTxt = sTxt & sBereich1
Set rng = Worksheets(sAktuell).Range(sBereich1)
rng.Formula = "=if(" & sTxt & "="""",""""," & sTxt & ")"
rng.Value = rng.Value
rng.Columns.AutoFit
Set rng = Worksheets(sAktuell).Range(sBereich2)
rng.Formula = "=if(" & sTxt & "="""",""""," & sTxt & ")"
rng.Value = rng.Value
rng.Columns.AutoFit
Set rng = Worksheets(sAktuell).Range(sBereich3)
rng.Formula = "=if(" & sTxt & "="""",""""," & sTxt & ")"
rng.Value = rng.Value
rng.Columns.AutoFit
Set rng = Worksheets(sAktuell).Range(sBereich4)
rng.Formula = "=if(" & sTxt & "="""",""""," & sTxt & ")"
rng.Value = rng.Value
rng.Columns.AutoFit
End Sub

gruss Rainer

Sub AusGeschlossenerDateiLesen() Dim sTxt As String ', sBereich1 As String, sBereich2 As String, sBereich3 As String, sBereich4 As String, sAktuell As String Dim rng As Range, rngCell As Range Dim sBereich As Variant Dim s As Integer sBereich = Array("a9:o9", "c16:z62", "a63:o84", "w103:ak220") For s = 0 To 3 sAktuell = Range("d1").Value 'Sheetname (ActiveSheet) sTxt = "'" & Range("B1").Value ' Path sTxt = sTxt & "[" & Range("B2").Value & "]" 'SheetName sTxt = sTxt & sAktuell & "'!" sTxt = sTxt & sBereich(s) Set rng = Worksheets(sAktuell).Range(sBereich(s)) rng.Cells(1).Formula = "=if(" & sTxt & "="""",""""," & sTxt & ")" rng.Cells(1).Copy rng rng.Value = rng.Value rng.Columns.AutoFit 'rng.Parent.Select Next s End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread