AW: Blatt-Transfer
28.12.2005 18:30:20
HansH
Moin Leonard,
wies der Zufall so will stolpere ich über einen Code von Udo. Der berücksichtigt allerdings nur die jeweilig erste Tabelle einer Datei. Hier der Code und eine von mir getestete Datei. Vielleich findet sich jemand der die Beschränkung nur eines Tabellenblattes aufheben kann.
https://www.herber.de/bbs/user/29561.xls
Sub Sheets_kopieren()
Dim strOrdner As String, _
strSF As Byte, _
FS As FileSearch, _
i As Integer, _
wbk As Workbook
strOrdner = InputBox("Ordner:", "Ordner eingeben")
If strOrdner = "" Then Exit Sub
strSF = MsgBox("Mit Unterordnern?", vbYesNo)
Set FS = Application.FileSearch
With FS
.LookIn = strOrdner
.Filename = "*.xls"
Select Case strSF
Case vbYes: .SearchSubFolders = True
Case vbNo: .SearchSubFolders = False
End Select
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set wbk = Workbooks.Open(.FoundFiles(i))
wbk.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
wbk.Close False
Next i
End If
End With
End Sub
Gruß
Hans