Nochmal Module Tauschen

Sub Export_Import()
Dim vbc As Object, iCounter As Integer, cType As String, StDateiname As String
Workbooks.Open "D:\Eigene Dateien\Eigene Tabellen\Exportmappe.xls"
SendKeys "%{F11} %Xi{TAB 9}" & "Dein Kennwort" & "{tab}{enter}{enter} %q"
For Each vbc In Workbooks("Exportmappe.xls").VBProject.VBComponents
With vbc.CodeModule
For iCounter = 1 To .CountOfLines
If .ProcOfLine(iCounter, 0) > "" Or InStr(1, .Lines(iCounter, 1), "Dim") <> 0 _
Or InStr(1, .Lines(iCounter, 1), "Public") <> 0 Or InStr(1, .Lines(iCounter, 1), "Type") <> 0 _
Or InStr(1, .Lines(iCounter, 1), "Static") <> 0 Or InStr(1, .Lines(iCounter, 1), "Declare") <> 0 Then
Select Case vbc.Type
Case 1: cType = ".bas"
Case 2, 100: cType = ".cls"
Case 3: cType = ".frm"
End Select
Workbooks("Exportmappe.xls").VBProject.VBComponents(vbc.Name).Export "C:\Temp\" & vbc.Name & cType
Exit For
End If
Next iCounter
End With
Next vbc
Workbooks.Open "D:\Eigene Dateien\Eigene Tabellen\Testmappe.xls"
SendKeys "%{F11} %Xi{TAB 9}" & "Dein Kennwort" & "{tab}{enter}{enter} %q"
With Workbooks("Testmappe.xls").VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
StDateiname = Dir("C:\temp\" & "*.*")
Do While StDateiname <> ""
If UCase(Right(StDateiname, 4)) = ".BAS" Or UCase(Right(StDateiname, 4)) = ".FRM" Or UCase(Right(StDateiname, 4)) = ".CLS" Then
.VBComponents.Import "C:\Temp\" & StDateiname
End If
StDateiname = Dir
Loop
For Each vbc In .VBComponents
If vbc.Type = 2 Then
If Left(vbc.Name, 5) = "Diese" Or Left(vbc.Name, 7) = "Tabelle" Then
.VBComponents(Left(vbc.Name, Len(vbc.Name) - 1)).CodeModule.InsertLines 1, vbc.CodeModule.Lines(1, vbc.CodeModule.CountOfLines)
.VBComponents.Remove .VBComponents(vbc.Name)
End If
End If
Next vbc
End With
End Sub