Belirli sütunları ayrı ayrı dosya olarak kaydetmek

[tugkan]

Merhabalar,
Örnek dosyadaki sütunları ayrı ayrı dosya olarak nasıl kaydettirebiliriz? Yardımcı olabilir misiniz?
Şartlar:
1 - H 'den Q'ya kadar olan her sütun eğer 2. satırdaki hücre dolu ise ayrı bir dosya olarak kaydedilecek, örnek olarak Q'ya kadar aldım ama sütun sayısı sabit değil, fazla da olabilir. Sadece başlangıç sabit "H".
2 - Dosya adları 2. Satırdaki hücre değerleri olacak. Eğer o hücre boş ise o sütunla ilgili işlem yapmasına gerek yok.
3 - A,B,C sütunları bütün dosyalarda olacak. Ama kullanım miktarı "0" olan satırlar silinecek.
4 - Satır sayısı örnek dosyadakinden fazla olabilir.

Teşekkür ederim

 

[muygun]

Merhaba;
Ekli dosya nerede ise dosyalarınız orada oluşur.
Deneyin.
İyi çalışmalar.

 

[tugkan]

@muygun Hocam teşekkür ederim. Dosya güzel çalışıyor ancak kusura bakmayın benim söylemeyi unuttuğum bir nokta var. 3. satırdaki hücreleri de aktarabilir misiniz?
Orjinal dosyada orada da veriler var ama örnek dosyada yazmamışım.

 

[muygun]

Eki tekrar deneyin.
İyi çalışmalar.

 

[tugkan]

Çok teşekkür ederim süper

 

[tugkan]

Sayın @muygun
4 numaralı mesajınızdaki dosya güzel çalışıyor. Peki dosyaları ayrı kaydetmeden hemen önce kayıt sayfasındaki D-E-F-G sütunlarını silerek kaydettirebilir misiniz?
Makro kaydet ile sütun silme yaptım ama bir türlü doğru yerde çağıramadım maalesef.
Edit: Müsait olan başka arkadaşlar da bakabilir tabiki de

 

[muygun]

Merhaba;
Eki deneyin.
Sayfayı farklı kaydet makrosuna 1 satır ekleyerek silme işlemi yapıldı.
İyi çalışmalar.

 

[tugkan]

Hocam,
Maalesef kayıt sayfasındaki D-E-F-G sütunlarını silmeden kaydetti

 

[muygun]

7 Nolu mesa ekini yani;
tugkan-REÇETELERİ AYRI DOSYALARA KAYDETMEK-2
dosyasını denediğinizden emin misiniz?
(ben bir sorun göremedim.)
7 No'lu mesaj ekini boş bir klasöre çıkartıp tekrar deneyin.
Ayrıca eklediğiniz ekte D-E-F-G sütunları boş!

 

[tugkan]

Yanlış anlatmış olabilirim. Sütunları tamamen silecek. H sütunundaki bilgiler D'ye gelmiş olacak.
Olması gereken şekli ekledim.

 

[muygun]

Merhaba;
Şimdi daha anlaşılır oldu.
Eki tekrar deneyin.
İyi çalışmalar.

 

[tugkan]

@muygun Hocam,
Çok hızlı ve güzel iş çıkarttınız

Tekrar teşekkürler...

 

[veyselemre]

Sub aktar()
    Set s1 = Sheets("REÇETE")
    s1.Select
    pth = ThisWorkbook.Path & "\"
    son = Cells(Rows.Count, 1).End(3).Row
    Application.DisplayAlerts = False
    For i = 8 To 17
        If Cells(i, 2) <> "" Then
            s1.Copy
            For ii = 8 To 17
                If i <> ii Then Cells(2, ii).ClearContents
            Next ii
            Range("H2:Q2").SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
            [D:G].Delete shift:=xlToLeft
            For iii = 5 To son
                If Cells(iii, "D").Value = 0 Then Cells(iii, "D").ClearContents
            Next iii
            Range("D5:D" & son).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            For Each shp In ActiveSheet.Shapes
                shp.Delete
            Next
            [a1].Select
            ActiveWorkbook.SaveAs pth & [d3], FileFormat:=-4143
            ActiveWorkbook.Close SaveChanges:=False
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

 

[tugkan]

@veyselemre Hocam sizin çözüme de baktım. Siz de anladığım kadarıyla aynı sayfadan çözmüşsünüz.
Alternatif olarak sizin çözümü de kaydediyorum.
Size de çok teşekkürler