[Çözüldü]  Makro ile belirli satırları silerek farklı kaydetme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Makro ile belirli satırları silerek farklı kaydetme

İleti#1)  Fbcandy » 27 Haz 2020 22:57

Merhabalar

Ekteki excelin orjinal halinde bazı formüller var.
Bu excelin önce formülünü kaldırıp sonra Master-Tablo ve Detay sheetlerini silmek , Daha sonra ise W:W sutünunda ki değerlere göre farklı kaydetmesini istiyorum. ( Her değeri ayrı bir excel olarak kaydetmek )

Makro çalıştığında;
W:W Sutununda sadece "A" yazanları formatı bozulmadan excel oluşturup masaüstüne kaydetmek( Dosya adı Today()+1 "A" )

W:W Sutununda sadece "B" yazanları formatı bozulmadan excel oluşturup masaüstüne kaydetmek( Dosya adı Today()+1 "B" )

W:W Sutununda sadece "C" yazanları formatı bozulmadan excel oluşturup masaüstüne kaydetmek( Dosya adı Today()+1 "C" )

Biraz uğraştım ama çok başarılı olamadım. Yardımcı olabilirseniz çok sevinirim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Fbcandy
 
Kayıt: 27 Haz 2020 21:05
Meslek: Lojistik
Yaş: 32
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul Sancaktepe

Cevap: Makro ile belirli satırları silerek farklı kaydetme

İleti#2)  Bülent » 28 Haz 2020 11:08

Merhaba,

Aşağıdaki kodları dener misiniz?

Kod: Tümünü seç
Sub FBCANDY()
Masaustu = Environ("USERPROFILE") & "\Desktop\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Ana Data").UsedRange.Select
Selection.Copy
ThisWorkbook.Worksheets("Ana Data").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

SON = ThisWorkbook.Worksheets("Ana Data").Range("A65530").End(3).Row
ThisWorkbook.Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter

Set TEDARIKCILER = CreateObject("Scripting.Dictionary")
For Each TEDARIKCI In ThisWorkbook.Worksheets("Ana Data").Range("W2:W" & SON)
    If Not TEDARIKCILER.Exists(TEDARIKCI.Value) Then
        TEDARIKCILER.Add TEDARIKCI.Value, TEDARIKCI.Address
    End If
Next

For Each BAK In TEDARIKCILER.Keys
If BAK = "" Then GoTo bitir
Dim dosyam
dosyam = VBA.Date + 1 & " " & BAK & ".xlsm"
ThisWorkbook.SaveCopyAs Masaustu & dosyam
Workbooks.Open (Masaustu & dosyam)
       
    With Workbooks(dosyam)
    .Activate
        .Worksheets("Ana Data").Select
        .Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter
        .Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter Field:=1, Criteria1:="<>" & BAK
        .Worksheets("Ana Data").Rows("2:" & SON).Delete
        .Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter
        .Worksheets("Ana Data").Range("A1").Select
        .Worksheets("Detay").Delete
        .Worksheets("Tablo").Delete
        .Worksheets("Master").Delete
        .Close True
    End With
Next
bitir:
Application.DisplayAlerts = True
Application.ScreenUpdating = Tru
MsgBox "İşlem tamam", vbInformation, "ExcelVba.Net - Bülent - Haziran 2020"

End Sub



İyi çalışmalar.
Kullanıcı avatarı
Bülent
Yönetim Kurulu
 
Adı Soyadı:Bülent ÖZTÜRK
Kayıt: 15 Haz 2008 00:08
Meslek: Bilgi Sistemleri
Yaş: 43
İleti: 3725
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İst/Çekmeköy

Cevap: Makro ile belirli satırları silerek farklı kaydetme

İleti#3)  Fbcandy » 29 Haz 2020 10:33

merhabalar

ilginiz için çok teşekküler . Makro çalışıyor ama birkaç güncelleme gerekecek sanırım.

Tedarikçi kısmında a,b,c olarak belirttiğimde sorun yok ancak a,b," Blanks" ,c,d olunca sadece a ve b yi alıyor. Blank ve sonrasını görmüyor. Bunu çözebilir miyiz ?

2. konuda bu alınan dosyaları belirli bir mail gurubuna gönderilmesini sağlayabilir miyiz ?
Kullanıcı avatarı
Fbcandy
 
Kayıt: 27 Haz 2020 21:05
Meslek: Lojistik
Yaş: 32
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul Sancaktepe

Cevap: Cevap: Makro ile belirli satırları silerek farklı kay

İleti#4)  Bülent » 29 Haz 2020 16:10

Fbcandy yazdı:Tedarikçi kısmında a,b,c olarak belirttiğimde sorun yok ancak a,b," Blanks" ,c,d olunca sadece a ve b yi alıyor. Blank ve sonrasını görmüyor. Bunu çözebilir miyiz ?

Boş dosya adı kullanamazsınız.
İsimsiz tedarikçi mi var, neden "blanks"?

Fbcandy yazdı:2. konuda bu alınan dosyaları belirli bir mail gurubuna gönderilmesini sağlayabilir miyiz ?

Tabi, mümkün.
Kullanıcı avatarı
Bülent
Yönetim Kurulu
 
Adı Soyadı:Bülent ÖZTÜRK
Kayıt: 15 Haz 2008 00:08
Meslek: Bilgi Sistemleri
Yaş: 43
İleti: 3725
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İst/Çekmeköy

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Makro ile belirli satırları silerek farklı kaydetme

İleti#5)  Fbcandy » 29 Haz 2020 16:37

[b]Boş dosya adı kullanamazsınız.
İsimsiz tedarikçi mi var, neden "blanks"?[/b][color=#4000BF][/color]

Boş olanları dosya yapmamasında sorun yok. Dolu olanları alması yeterli olacaktır. Nasıl yapabilirim ?

Mail için kod verme şansınız olur mu ?
Kullanıcı avatarı
Fbcandy
 
Kayıt: 27 Haz 2020 21:05
Meslek: Lojistik
Yaş: 32
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul Sancaktepe

Cevap: Makro ile belirli satırları silerek farklı kaydetme

İleti#6)  Bülent » 30 Haz 2020 07:49

Boş satırları atlayıp, işleme devam etmesi için kodu aşağıdaki gibi değiştirebilirsiniz:

Kod: Tümünü seç
Sub FBCANDY()
Masaustu = Environ("USERPROFILE") & "\Desktop\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Ana Data").UsedRange.Select
Selection.Copy
ThisWorkbook.Worksheets("Ana Data").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

SON = ThisWorkbook.Worksheets("Ana Data").Range("A65530").End(3).Row
ThisWorkbook.Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter

Set TEDARIKCILER = CreateObject("Scripting.Dictionary")
For Each TEDARIKCI In ThisWorkbook.Worksheets("Ana Data").Range("W2:W" & SON)
    If Not TEDARIKCILER.Exists(TEDARIKCI.Value) Then
        TEDARIKCILER.Add TEDARIKCI.Value, TEDARIKCI.Address
    End If
Next

For Each BAK In TEDARIKCILER.Keys
If BAK = "" Then GoTo sonraki
Dim dosyam
dosyam = VBA.Date + 1 & " " & BAK & ".xlsm"
ThisWorkbook.SaveCopyAs Masaustu & dosyam
Workbooks.Open (Masaustu & dosyam)
       
    With Workbooks(dosyam)
    .Activate
        .Worksheets("Ana Data").Select
        .Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter
        .Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter Field:=1, Criteria1:="<>" & BAK
        .Worksheets("Ana Data").Rows("2:" & SON).Delete
        .Worksheets("Ana Data").Range("W1:W" & SON).AutoFilter
        .Worksheets("Ana Data").Range("A1").Select
        .Worksheets("Detay").Delete
        .Worksheets("Tablo").Delete
        .Worksheets("Master").Delete
        .Close True
    End With
sonraki:
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = Tru
MsgBox "İşlem tamam", vbInformation, "ExcelVba.Net - Bülent - Haziran 2020"

End Sub




Mail gönderme ile ilgili Excel ile Mail İşlemleri ( viewforum.php?f=93) konu başlığında çeşitli örnekler mevcut, inceleyebilirsiniz.

Bazıları:

viewtopic.php?f=93&t=34856

viewtopic.php?f=93&t=29689

viewtopic.php?f=93&t=32524

viewtopic.php?f=93&t=30930
Kullanıcı avatarı
Bülent
Yönetim Kurulu
 
Adı Soyadı:Bülent ÖZTÜRK
Kayıt: 15 Haz 2008 00:08
Meslek: Bilgi Sistemleri
Yaş: 43
İleti: 3725
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İst/Çekmeköy

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Makro ile belirli satırları silerek farklı kaydetme

İleti#7)  Fbcandy » 30 Haz 2020 09:38

Değerli destekleriniz için çok teşekkür ederim. şkşk
Kullanıcı avatarı
Fbcandy
 
Kayıt: 27 Haz 2020 21:05
Meslek: Lojistik
Yaş: 32
İleti: 4
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul Sancaktepe

Cevap: Makro ile belirli satırları silerek farklı kaydetme

İleti#8)  Bülent » 30 Haz 2020 12:26

Rica ederim.
Çalışmalarınızda başarılar.
Kullanıcı avatarı
Bülent
Yönetim Kurulu
 
Adı Soyadı:Bülent ÖZTÜRK
Kayıt: 15 Haz 2008 00:08
Meslek: Bilgi Sistemleri
Yaş: 43
İleti: 3725
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İst/Çekmeköy


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 2 misafir

Bumerang - Yazarkafe