Diskussionsgruppe: Tabellenkalkulation
HuHu, Leute
So machen wir's schnell und schmerzlos ...
Ich will in der Schleife alle geöffneten Tabellen
schließen außer die HauptTabelle (test lücken.xls)
Kann mir jeamdn weiter helfen?
Dim FileName(1 To 2000) As String
Dim MaxTab As Integer
Sub Main()
Call Msg
Call Scopy
End Sub
Sub Scopy()
ChDir "D:\*****\******\"
'
For I = 1 To MaxTab
Workbooks.Open FileName:=FileName(I)
Application.CutCopyMode = False
Range("A5:A5").Select
Selection.Value = ActiveWorkbook.Name
Range("A5").Select
Text1 = ActiveCell.Value
Range("B5:L12").Select
Selection.Copy
Windows("test lücken.xls").Activate
Zeile = (5 + (I - 1) * 8)
Range(Cells(Zeile, 2), Cells(Zeile, 12)).Select
ActiveSheet.Paste
Range(Cells(Zeile, 1), Cells(Zeile, 1)).Select
ActiveCell.Value = Text1
Next I
End Sub
Sub Msg()
Set fs = Application.FileSearch
With fs
.LookIn = "D:\****\*****\"
.FileName = "*.xls"
MaxTab = fs.FoundFiles.Count
If .Execute(SortBy:=msoSortByFileName) > 0 Then
For I = 1 To .FoundFiles.Count
' MsgBox .FoundFiles(I)
FileName(I) = fs.FoundFiles(I)
Next I
Else
MsgBox "There were no files found."
End If
End With
End Sub
Von: Kennyger Datum: 09.03.2007, 07:33
Antwort 1
von Beverly vom 09.03.2007, 09:53
Hi,
vom Prinzip her geht das so
Sub schließen()
Dim inTabellen As Integer
For inTabellen = Application.Workbooks.Count To 1 Step -1
If Workbooks(inTabellen).Name <> ThisWorkbook.Name Then Workbooks(inTabellen).Close
Next inTabellen
End Sub
Bis später,
Karin
Antwort 2
von Kennyger vom 09.03.2007, 10:26
DANKE !!!!!
hat funktioniert !!!
THX
bye Kennyger
|
07121
07122
07123
07124
07125
07126
07127
07128
|
