Farklı kaydetmek

[serdarexe]

Merhaba arkadaşlar,
S isimli excel dosyam var sizlerden ricam,
C:\Users\Personel\Desktop\Günlük raporlar içine kayıt olacak ve D2 hücresindeki isim excel dosyamın ismi olacak, kayıt başarılı olursa msgbox ile bilgi versin istiyorum rica etsem lütfen yardımcı olur musunuz.

Ayrıca dosya ekleyemedim, ekleyecek yeri bulamadım

 

[Murat OSMA]

[FONT="Trebuchet MS"][SIZE="2"]ActiveWorkbook.SaveAs Filename:="C:\Users\Personel\Desktop\Günlük raporlar\" & Cells(2, 4).Value & ".xls"[/SIZE][/FONT]

 

[serdarexe]

Murat bey ilginiz için teşekkür ederim, kodu yazdığımda aynı şekilde kayıt etmiyor sanki görsellik bozulmuş gibi oluyor ve kayıt yerine dosya açıyor ben sadece aynı şekilde excel çalışma sayfası olarak kayıt etmek istiyorum : (

 

[Excelmy]

ben sadece aynı şekilde excel çalışma sayfası olarak kayıt etmek istiyorum

Kodlarınız,

Sub fsv()
Dim deger, Kaynak
deger = ActiveSheet.Range("D2").Value
Kaynak = "C:\Users\Personel\Desktop\Günlük raporlar"
On Error Resume Next
If Dir(Kaynak) Then MkDir (Kaynak)
ActiveSheet.Copy
ActiveSheet.DrawingObjects.Delete
Call vbclr
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Kaynak & "\" & deger & ".xls", FileFormat:=xlWorkbookNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
ActiveWorkbook.Close False
End Sub
Sub vbclr()
Dim component, modul
For Each component In ActiveWorkbook.VBProject.VBComponents
    If component.Type <> 100 Then
        ActiveWorkbook.VBProject.VBComponents.Remove component
    Else
        Set modul = component.CodeModule
        modul.DeleteLines 1, modul.CountOfLines
    End If
Next
End Sub

 

[serdarexe]

Kısa yol makro yaptım ve kodları komple yapıştırdım, Sonuç MÜKEMMEL, Allah razı olsun sizden çok teşekkür ederim.

Farklı kayıt etme işlemi bittikten sonra Msgbox ile bilgi vermek mümkünmüdür. kayıt başarılı ise bilgi versin başarısız ise bilgi versin bu konuda da yardım eder misiniz.

Kodlarla ilgili bir sorum olacak, "farklıkaydet" diye bir makro açtım. 2. kod kısmı yani "Sub vbclr() den sonrası ne işe yarıyor. Ben komple kopyalayıp yapıştırdım makronun kendisi "vbclr"adlı bir makro daha açmış ve kodlar var. Ama yinede mükemmel çalışıyor.

 

[Excelmy]

Farklı kayıt etme işlemi bittikten sonra Msgbox ile bilgi vermek mümkünmüdür. kayıt başarılı ise bilgi versin başarısız ise bilgi versin bu konuda da yardım eder misiniz.

fsv kodları sonuna ekleyiniz,

If CreateObject("Scripting.FileSystemObject").FileExists("" & Kaynak & "\" & deger & ".xls") Then
MsgBox "KLASOR : " & Kaynak & "" & vbLf & "DOSYA ADI : " & deger & "" & vbLf & "Kayıt Yapıldı", , ""
Else
MsgBox "Kayıt Yapılmadı", , ""
End If

Kodlarla ilgili bir sorum olacak, "Sub vbclr() den sonrası ne işe yarıyor.

Sadece sayfayı kaydetmek istediğiniz için vba kodlarını kaldırıyoruz

 

[serdarexe]

Çok teşekkür ederim elleriniz dert görmesin, Tek kelime ile süpersiniz.

 

[cigilipap]

Merhabalar

Kodlar çok işime yaradı.
Ancak şöyle bir sorunum var ben kopya oluşturduğum yerde makroların kalmasını istiyorum. Bu durumda dosya uzantım xlsm olmalı değilmi?

Birde oluşan kopyada veri doğrulama ile yapılan liste seçeneklerim kayboluyor.

Kısacası benim ihtiyacım olan makro belirlediğim dosya yoluna belirlediğim hücre ismi ile dosyanın birebir kopyasının oluşturulması

Şimdiden teşekkür ederim.

 

[muttabomer]

Murat hocam,

Benimde sıkıntı şu şekilde

Sub FarkliKaydet()

Dim yol As String, ft_no As String

yol = "/Volumes/Merkez_MAC/MERKEZ/H/01_HALÜL K†‚†KKINACI/FATURALAR/MAC_FATURA/"
ft_no = Application.InputBox("Fatura Numarasİnİ Yazİn.", "KAYIT")

If ft_no = "" Then
MsgBox "Kayİt Yapmadİm! ....... Fatura No Boß Bİrakİlmaz"
Exit Sub
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ActiveWorkbook.Sheets("FATURA").Copy
ActiveWorkbook.SaveAs Filename:=yol & "" & ft_no & "_" & _
[H24] & "_" & Format([CH50], "_dd.mm.yyyy") & ".xls", FileFormat:=53
ActiveWorkbook.Close

Application.ScreenUpdating = True
End Sub

Makroda ActiveWorkbook.Sheets("FATURA").Copy gelince duruyor.
Çalışma zamanı hatası '1004':
Worksheet sınıfının Copy yöntemi başarısız. diye uyarı veriyor.

Burdaki amacım Kitabım 3 sayfadan oluşuyor.
Ben sadece 1.sayfa (Sheets.("FATURA")) kaydetmesini istiyorum.

Yardımcı olursanız sevinirim.

 

[muttabomer]

Excelmy Yardımcı olabilirmisin,,,
Bir üstteki konu için

 

[paradaymh]

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [B4:B54]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
Application.EnableEvents = False
Target.Value = BuyukHarf(Target.Value)
Application.EnableEvents = True



If Intersect(Target, Range("D4:E54,A1:F3")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Not IsEmpty(Target.Address) Then
Application.Undo

Application.EnableEvents = True
End If
Exit Sub
End Sub

Function BuyukHarf(Veri As String)

BuyukHarf = UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I"))

End Function


bu ikisi bir türlü çalışmadı yardım lütfen