AW: Spalten einfügen
14.04.2005 10:16:04
Rolf
Hallo Richard,
der folgende Code geht davon aus,
dass du in einer Inputbox eingibst,
welche Spalten eingefügt werden sollen.
Diese werden dann bei allen Dateien + allen Sheets
im ausgewählten Verzeichnis eingefügt.
Du tust also gut daran, zunächst mal ein Testverzeichnis
mit wenigen Dateien anzulegen und dir anzusehen,
ob die Wirkung deinen Vorstellungen entspricht.
Melde dich bitte, ob's ok ist.
fG
Rolf
Option Explicit
Dim InsertCols As String
'Startprozedur
Sub start_insert_cols()
'Rolf Beißner.hf.14.04.05
Const VerzDefault As Variant = "C:\"
Dim verz As String
verz = Ordner_def(VerzDefault)
ChDir verz
InsertCols = InputBox("Bitte die Spalten eingeben", "Spalteneingabe", "C:D")
Application.ScreenUpdating = False
WorkFileList (verz)
End Sub
'Excel-Dateien öffnen + Spalten in jedes Sheet einfügen
Sub WorkFileList(folderspec)
On Error Resume Next
Dim fs As Object, f As Object, fc As Object, fl As Object
Dim s As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each fl In fc
If fl.Type = "Microsoft Excel-Arbeitsblatt" Then
Workbooks.Open fl.Name
For Each s In Sheets
s.Columns(InsertCols).Insert Shift:=xlToRight
Next
Workbooks(fl.Name).Close True
End If
Next
End Sub
'Ordnerdefinition
'aus Herber-Forum von K.Rola am 11.10.04
Function Ordner_def(defaultwert As Variant) As String
Dim objFolderItem As Object, strPath As String, objShell As Object
Dim objFolder As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultwert)
If objFolder Is Nothing Then End
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Ordner_def = strPath
End Function