nachfolgend seht ihr mein Makro mit den eine Liste erstellt wird.
Mein Problem:
Am Ende werden die Werte in eine neue Datei kopiert und das Modul "Telefonieren" soll in die gleiche neue Datei in diesen Makro kopiert werden.
Wenn mehr Info benötigt wird kann ich gern mal die komplette Datei zumailen
Private Sub btnDatensatz_suchen_Click()
Sheets("Berechnung").Select
Range("B1").Select
Selection.CurrentRegion.Select
Zähler = Selection.Areas.Count
If Zähler <= 1 Then
Mldg = "Es wurden " & _
Selection.Rows.Count & " Datensätze eingelesen."
Stil = vbOKOnly + vbInformation + vbDefaultButton2
Title = "Datensatzsuchprogramm"
Kontext = 1000
Ergebnis = MsgBox(Mldg, Stil, Title, Help, Kontext)
Else
For i = 1 To Zähler
MsgBox "Teil " & i & " der Markierung enthält " & _
Selection.Areas(i).Rows.Count & " Zeilen."
Next i
End If
Sheets("Berechnung").Select
Ergebnis = MsgBox("Datensätze werden gesucht", Stil, "Datensatzsuchprogramm", Help, Kontext)
'Fügt die Berechnungsformeln ein
Application.Cells(1, 6).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;3;FALSCH)"
Application.Cells(1, 7).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;4;FALSCH)"
Application.Cells(1, 8).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;5;FALSCH)"
Application.Cells(1, 9).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_Orka;6;FALSCH)"
'Legt die Anzahl der zusuchenden Datensätze fest
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 6), Cells(1, 9))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 6), Cells(Selection.Rows.Count, 9))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
Range("B1").Select
Selection.CurrentRegion.Select
Zähler = Selection.Areas.Count
If Zähler <= 1 Then
Else
For i = 1 To Zähler
Next i
End If
Application.Cells(1, 1).Formula = "1"
Application.Cells(2, 1).Formula = "2"
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 1), Cells(2, 1))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 1), Cells(Selection.Rows.Count, 1))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
'Fügt die Berechnungsformeln ein
Application.Cells(1, 11).Formula = "=SVERWEIS(Port_Neu;Zurü_Suchbereich;2;FALSCH)"
Application.Cells(1, 12).Formula = "=SVERWEIS(Port_Neu;Zurü_Suchbereich;3;FALSCH)"
Application.Cells(1, 13).Formula = "=SVERWEIS(Port_Neu;Zurü_Suchbereich;4;FALSCH)"
'Legt die Anzahl der zusuchenden Datensätze fest
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 11), Cells(1, 13))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 11), Cells(Selection.Rows.Count, 13))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
'Fügt die Berechnungsformeln ein
Application.Cells(1, 14).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_T_DSL;2;FALSCH)"
Application.Cells(1, 15).Formula = "=SVERWEIS(Rufnummer_DLU;Suchbereich_T_DSL;3;FALSCH)"
'Legt die Anzahl der zusuchenden Datensätze fest
Set AktuellerQuellbereich = _
ActiveSheet.Range(Cells(1, 14), Cells(1, 15))
Set AktuellerFüllbereich = _
ActiveSheet.Range(Cells(1, 14), Cells(Selection.Rows.Count, 15))
AktuellerQuellbereich.AutoFill Destination:=AktuellerFüllbereich
Range("B1").Select
Selection.CurrentRegion.Select
Zähler = Selection.Areas.Count
If Zähler <= 1 Then
Else
For i = 1 To Zähler
Next i
End If
'Kopiert nur die Werte in die Umschalteliste
Range("Umschaltliste").Select
Selection.Copy
Sheets("Umschalteliste").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Berechnung").Select
Application.CutCopyMode = False
Sheets("Umschalteliste").Select
ActiveCell.Select
Sheets("Umschalteliste").Select
frmSuchen.Hide
Sheets("Umschalteliste").Copy
'kopiert das Modul Telefonieren in die neue Datei
Dim sPath As String
sPath = Application.Path & "\"
ThisWorkbook.VBProject _
.VBComponents("Telefonieren").Export sPath & "Telefonieren.bas"
Workbooks.Add
With ActiveWorkbook.VBProject
.VBComponents.Import sPath & "Telefonieren.bas"
.VBComponents("Telefonieren").Name = "Telefonieren"
End With
Kill sPath & "\Telefonieren.bas"
Mldg = "Liste wurde erfolgreich" & _
" erstellt "
Stil = vbOKOnly + vbInformation + vbDefaultButton1
Title = "Datensatzsuchprogramm"
Kontext = 1000
Ergebnis = MsgBox(Mldg, Stil, Title, Help, Kontext)
'schließt das Programm ohne die Daten zuspeichern
Windows("Datensatzsuchprogramm.XLS").Activate
ActiveWorkbook.Close SaveChanges:=False
End Sub