mappe speichern

Sub zelle_Mappe_dateiname()
Dim datname As String
Dim i As Integer
Dim h As String
Dim o As String
Dim uo As String
Dim uo1 As String
For i = 1 To 4
'Datei name
datname = Sheets("Tabelle1").Cells(i, 1).Value
h = Cells(2, 3).Value
o = Cells(2, 4).Value
uo = Cells(2, 5).Value
uo1 = Cells(2, 6).Value
'Next i
'Pfad
'Ich möchte nur Tabelle2 als Datei speichern,orginalmappe nicht schliessen
ActiveWorkbook.SaveAs h & ":\" & o & "\" & uo & "\" & uo1 & datname & ".xls"
Next i
ActiveWindow.Close
End Sub

Sub TextInArbeitsmappeSuchenUndKennzeichnen()
Dim s As String
Dim i As Integer
Dim Erg1 As Variant
Dim Erg2 As Variant
s = InputBox("Geben Sie den Suchbegriff ein!", "Textsuche")
If s = "" Then Exit Sub
For i = 1 To ActiveWorkbook.Sheets.Count
Sheets(i).Activate
Set Erg1 = Sheets(i).Cells.Find(s)
If Not Erg1 Is Nothing Then
Erg2 = Erg1.Address
Do
With Erg1
.Activate
.Interior.ColorIndex = 4
End With
Set Erg1 = Cells.FindNext(After:=ActiveCell)
On Error Resume Next
If Erg1.Address = Erg2 Then Exit Do
Erg1.Interior.ColorIndex = 4
Loop
End If
Next i
End Sub