dosya yedekleme hakkında

[onurcan1979]

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

git = ActiveSheet.Name
Klasor = ThisWorkbook.Path & "\yedek"

On Error Resume Next
If Dir(Klasor) = "" Then MkDir Klasor

Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
Dim sayfa As Worksheet

Dim myArray() As Variant
Dim i As Integer
Dim j As Integer
j = 0
For i = 1 To Sheets.Count
r = 0
If Sheets(i).Name = "Sayfa1" Then
r = 1
ElseIf Sheets(i).Name = "Sayfa2" Then
r = 1

End If

If r = 1 Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If

Next i
Sheets(myArray).Select
Sheets(myArray).Copy

For i = 1 To Len(ThisWorkbook.Name)
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Dosya_adi = Mid(ThisWorkbook.Name, 1, i - 1)
uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
End If
Next


For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).Files
If Mid(Dosya.Name, 1, Len(Dosya_adi)) = Dosya_adi Then
sat = sat + 1
a = ds.FileExists(Klasor & "\" & Dosya_adi & sat & uzanti)
If a = True Then
Else
son = 1
Exit For
End If
End If
Next


If son = 0 Then
sat = sat + 1
End If

deger = Dosya_adi & sat & uzanti


For i = 1 To ActiveWorkbook.Sheets.Count

ActiveWorkbook.Sheets(Sheets(i).Name).Select
Dim x As Range
For Each x In [A1:K30]
If x.Value <> "" Then
x.Value = x.Value
End If
Next x
Next
ActiveWorkbook.Sheets(Sheets(1).Name).Select

ActiveWorkbook.SaveAs Klasor & "\" & deger
ActiveWorkbook.Close SaveChanges:=False
Sheets(git).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
MsgBox Klasor & "\" & deger & Chr(10) & Chr(10) & _
"Kayıt yapıldı", vbInformation, deger

yukarıdaki kodu kullanıyorum gayette güzel bir çalışma. fakat ben bu kodun içinde bir ek daha istiyorum yedek alırken UserForm1 de bulunan textbox' sa yazdığım isim altına dosya oluşturarak yedeklemesini istiyorum yani kitab doyasına textbox tan isim vermek istiyorum bu konuda yardımcı olursanız çok sevinirim dosya öreneği ekte

 

[onurcan1979]

günaydın arkadaşlar bu konu hakkında bana yardımcı olabilirmisiniz?

 

[onurcan1979]

iyi günler arkadaşlar bu konu hakkında bana yardım edebilecek bir arkadaş varmı?

 

[onurcan1979]

iyi akşamlar

 

[onurcan1979]

bana bu konuda yardım edebilecek bir arakadaş yokmu?

 

[onurcan1979]

Arakadaşlar bana bu konuda yardımcı olacak biri yokmu?

 

[halit3]

kodun bu bölümünü

Dosya_adi = Mid(ThisWorkbook.Name, 1, i - 1)

bununla değiştir

Dosya_adi = TextBox4.Text

 

[onurcan1979]

çok teşekkürler emeğinize bilginize sağlık