• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Vba ile hücre içindeki değerle klasör açmak

Katılım
25 Ekim 2006
Mesajlar
31
Excel Vers. ve Dili
excel 2003 türkçe
Merhabalar, tarafımıza gelen siparişleri takip etmek için hazırladığım. Ancak bir türlü beceremediğim sorunum için yardımlarınızı bekliyorum.amacım 2018 yılı içersinde gelen her sipariş için 2018 yılı klasörünün içinde firmaları otomatik oluşturup, vermiş olduğum sipariş no ile örnek dosyanın ismini farklı kaydedip ilgili müsterinin klasörünü içine kopyalamak istiyorum. Bu nedenle;
mesajımın ekinde göndermiş olduğum bos sıparıs formu içindeki örnek sayfasında,
c8 hücresindeki yazının aynısını çalışma klasörümün altındaki 2018 klasörünü altında kontrollü bir şekilde otomatik olarak oluşturup, daha sonra bu c8 hücresindeki firmanın klasörüne doldurmuş olduğum sipariş formunun aynısını ı9 hücresindeki sipariş no ismi ile vba dan kaydetmek istiyorum.ilgilenen tüm arkadaşlara şimdiden teşekkürler.. Soner erim
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Ekte dosyanız yok!
 
arkadaşlar bu konu ile ilgili yardımcı olacak kimse yok mu
 
Farklı klasöre dosya kopyalama

Arkadaşlar yardım edecek yok mu.
Forum da aradım. Ancak bir türlü yapamadım.
Sizlerden acil yardım bekliyorum.
 
Deneyiniz.

Kod:
Option Explicit

Private Sub CommandButton1_Click()
    Dim Klasör As String, Dosya As String
    Dim Sipariş_Dosyası As Workbook, Nesne As Object
    
    Klasör = ThisWorkbook.Path & "\" & "2018"
    
    If Dir(Klasör, vbDirectory) = "" Then
        MkDir (Klasör)
    End If

    Dosya = Klasör & "\" & Sheets("ÖRNEK").Range("C8").Value & " " & Sheets("ÖRNEK").Range("I9").Value & ".xlsx"
    
    If Dir(Dosya) = "" Then
        Application.DisplayAlerts = False
        Sheets("ÖRNEK").Copy
        Set Sipariş_Dosyası = ActiveWorkbook
        Sipariş_Dosyası.Sheets(1).Name = Sheets("ÖRNEK").Range("I9").Value
        
        For Each Nesne In ActiveSheet.OLEObjects
            If Nesne.progID = "Forms.CommandButton.1" Then
                Nesne.Delete
            End If
        Next
    
        Sipariş_Dosyası.SaveAs Dosya
        Sipariş_Dosyası.Close
        
        MsgBox "Sipariş kayıt edilmiştir.", vbInformation
    Else
        MsgBox "Bu sipariş dosyası daha önce kayıt edilmiştir.", vbCritical
    End If
End Sub
 
Vba klasör kopyalama

Korhan bey vermiş olduğunuz kod işime çok yaradı. çok teşekkürler. Ellerinize sağlık.
 
Geri
Üst