masa üstüne ayrı isimlerde klasör oluşturma

[ADER_34]

Merhaba arkadaşlar örnek dosyamda "G" sütununda "EVRAK ID" "F" sütununda "SAHİP" isim ve soy isimleri var, makro kodunu çalıştırınca bilgisayarımın masa ütüne EVRAK ID ve "G" ve "F" sütunuda olan isim soy isme ait ayrı ayrı boş klasör açması bu mümkün mü? teşekkürler.

İndir Örnek klasör aç xlsm

Dosyayı indir Örnek klasör aç xlsm

dosya.co

 

[volki_112]

Merhaba arkadaşlar örnek dosyamda "G" sütununda "EVRAK ID" "F" sütununda "SAHİP" isim ve soy isimleri var, makro kodunu çalıştırınca bilgisayarımın masa ütüne EVRAK ID ve "G" ve "F" sütunuda olan isim soy isme ait ayrı ayrı boş klasör açması bu mümkün mü? teşekkürler.

İndir Örnek klasör aç xlsm

Dosyayı indir Örnek klasör aç xlsm

dosya.co

deneyiniz.

Sub KlasorleriOlustur()

    Dim ws As Worksheet
    Dim sonSatir As Long, i As Long
    Dim evrakID As String, sahip As String
    Dim klasorAdi As String, masaustu As String
    
    ' Aktif sayfa
    Set ws = ActiveSheet
    
    ' Son satırı bul
    sonSatir = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    
    ' Kullanıcının masaüstü yolu
    masaustu = Environ("USERPROFILE") & "\Desktop\"
    
    ' Satırları dolaş
    For i = 2 To sonSatir ' Başlık varsa 2. satırdan başla
        evrakID = Trim(ws.Cells(i, "G").Value)
        sahip = Trim(ws.Cells(i, "F").Value)
        
        If evrakID <> "" And sahip <> "" Then
            ' Klasör adı = EVRAKID + "_" + SAHİP
            klasorAdi = masaustu & evrakID & " - " & sahip
            
            ' Eğer klasör yoksa oluştur
            If Dir(klasorAdi, vbDirectory) = "" Then
                MkDir klasorAdi
            End If
        End If
    Next i
    
    MsgBox "Klasörler başarıyla oluşturuldu!", vbInformation

End Sub

 

[ADER_34]

Merhaab volki12 kodlar sorunsuz çalışıyor çok teşekkür ederim,tek bir isteğim var sizden masaüstünde dağınık değilde "EVRAK ID" adlı bir klasör içnde toplasın,teşekkürler.

 

[volki_112]

Merhaab volki12 kodlar sorunsuz çalışıyor çok teşekkür ederim,tek bir isteğim var sizden masaüstünde dağınık değilde "EVRAK ID" adlı bir klasör içnde toplasın,teşekkürler.

bunu deneyiniz.

Sub KlasorleriOlustur()

    Dim ws As Worksheet
    Dim sonSatir As Long, i As Long
    Dim evrakID As String, sahip As String
    Dim klasorAdi As String, masaustu As String, anaKlasor As String
    
    ' Aktif sayfa
    Set ws = ActiveSheet
    
    ' Son satırı bul
    sonSatir = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    
    ' Kullanıcının masaüstü yolu
    masaustu = Environ("USERPROFILE") & "\Desktop\"
    
    ' Masaüstünde "EVRAK ID" adlı ana klasör oluştur (yoksa)
    anaKlasor = masaustu & "EVRAK ID"
    If Dir(anaKlasor, vbDirectory) = "" Then
        MkDir anaKlasor
    End If
    
    ' Satırları dolaş
    For i = 2 To sonSatir ' Başlık varsa 2. satırdan başla
        evrakID = Trim(ws.Cells(i, "G").Value)
        sahip = Trim(ws.Cells(i, "F").Value)
        
        If evrakID <> "" And sahip <> "" Then
            ' Alt klasör adı = EVRAKID + "_" + SAHİP
            klasorAdi = anaKlasor & "\" & evrakID & " - " & sahip
            
            ' Eğer klasör yoksa oluştur
            If Dir(klasorAdi, vbDirectory) = "" Then
                MkDir klasorAdi
            End If
        End If
    Next i
    
    MsgBox "Klasörler başarıyla '" & anaKlasor & "' içine oluşturuldu!", vbInformation

End Sub

 

[ADER_34]

Volki 12 kodlar süper çalılşıyor çok teşekkür ederim,eğer mümkünse örnek dosyamda ki "G" ve "H" sütununda ki isim soy isimleri klasörler içine ayrı ayrı "EVRAK ID" ve isim "soy isim" olarak Excel dosyası olarak bölebilir miyiz? yani aynı dosya içinde hem klasör hemde excel sayfası olacak.

İndir Örnek klasör aç xlsm

Dosyayı indir Örnek klasör aç xlsm

dosya.co