Makroya İlave Kod Eklemek

[ormann]

Merhabalar ;
Ekteki örnek dosyada iki adet sayfa var "M3" sayfasındaki kaydet butonuna bastığımda açılan pencereye yeni dosya ismini giriyorum.ve kaydet butonuna bastığımda D sürücüsünün içerisine o isimle kayıt yapılıyor.Benim asıl yapmak istediğim bu makroya ilave olarak kaydet butonuna bastığımda M3 sayfasındaki sarı renkli hücrelerin Ebat listeleri Sayfasındaki karşılığına gelen hücrelerede aktarılmasıdır.Bu konuda yardımınıza ihtiyacım var .Şimdiden teşekkürlerimi sunuyorum.

 

[ormann]

Arkadaşlar acil yardım

 

[ormann]

Iyi aksamlar.Rica etsem 1.nolu mesajıma yardımcı olabilir misiniz

 

[vardar07]

Iyi aksamlar.Rica etsem 1.nolu mesajıma yardımcı olabilir misiniz

Merhaba. Aşağıdaki kodları değiştirip denermisiniz.

Private Sub CommandButton2_Click()
Sheets("EBAT LİSTELERİ").Unprotect 1978
Application.ScreenUpdating = False

'-------------------eklenen kod----------------------
Set s1 = Sheets("ebat listeleri")
Set s2 = Sheets("m3")
Son_Dolu_Satir = s1.Range("c65536").End(xlUp).Row
    Bos_Satir = Son_Dolu_Satir + 1
   s1.Range("B" & Bos_Satir).Value = _
                   Application.WorksheetFunction.Max(S1.Range("B:B")) + 1
    s1.Range("c" & Bos_Satir).Value = s2.[C1] 
    s1.Range("d" & Bos_Satir).Value = s2.[C4] 
    s1.Range("e" & Bos_Satir).Value = s2.[C5] 
[COLOR="Red"]Range("D7:BE978").Select
    ActiveWorkbook.Worksheets("EBAT LİSTELERİ").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("EBAT LİSTELERİ").Sort.SortFields.Add Key:=Range( _
        "G7:G978"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("EBAT LİSTELERİ").Sort
        .SetRange Range("D7:BE978")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
[/COLOR]
Application.EnableEvents = False
dosya = ActiveWorkbook.Name
Set flk = CreateObject("Scripting.FileSystemObject")
uzanti = flk.GetExtensionName(dosya) ' uzantı buluyor
dosya2 = flk.GetBaseName(dosya) ' dosyanın kendisi
klasor = "D:\"
Dosya_adi = InputBox("DOSYANIN ADINI DEĞİŞTİREBİLİRSİNİZ.", "UYARI!", dosya2)
If Dosya_adi = "" Then MsgBox "DOSYA ADINI YAZMADINIZ.": Exit Sub
Kayıt_Yeri = klasor & "\" & Dosya_adi & "." & uzanti
If CreateObject("Scripting.FileSystemObject").FileExists(Kayıt_Yeri) = True Then
MsgBox " Bu isimde bir dosya var"
Else
ActiveWorkbook.Save
If flk.FolderExists(klasor) = False Then
MkDir klasor
End If
flk.CopyFile ThisWorkbook.FullName, Kayıt_Yeri
MsgBox "DOSYANIZ AŞAĞIDAKİ İSİMLE KAYIT YAPILMIŞTIR." & Chr(10) & Chr(10) & Kayıt_Yeri, vbInformation, "U Y A R I "
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox Range("G15") & "  NUMARALI İSTİF EBAT LİSTESİ KAYIT DEFTERİNE AKRARILDI", vbInformation
Sheets("EBAT LİSTELERİ").Select
Application.Wait Now + TimeValue("00:00:03")
Sheets("EBAT LİSTELERİ").Protect 1978
End Sub

 

[ormann]

Sayın Vardar çok teşekkür ederim.Acaba ebat listesi sayfasında b sutununa her veri aktarmada sıra numarası verdi rebilirmiyiz

 

[vardar07]

Sayın Vardar çok teşekkür ederim.Acaba ebat listesi sayfasında b sutununa her veri aktarmada sıra numarası verdi rebilirmiyiz

4 Nolu mesajdaki kırmızı ile belirtilen yeri ekleyiniz.

 

[ormann]

Sayın Vardar çok teşekkür ediyorum.Sizden şöyle bir ricam olacak kayıt yapıp ebat listesi sayfasına aktarıldıktan sonra tüm veriler (d7:BE) , g7 hücresinde bulunan istif numaralarına göre küçükten büyüğe doğru sıralanabilirmi?

 

[vardar07]

Sıralanır ancak sadece kriter g sütunu ise yukardaki kodu deneyin. İlerde kriterler değişecekse yapmak istediğinizi bir bütün olarak söylerseniz ona göre hareket etmek lazım. Sebebi G6 sütunu kriter olursa D sütunu yılı karışık olur. Sadece g sütunu ise yukardaki kod güncellendi.

 

[ormann]

Sayın Vardar aşağıdaki kodda hata alıyorum.
ActiveWorkbook.Worksheets("EBAT LİSTELERİ").Sort.SortFields.Clear

 

[vardar07]

Sayın Vardar aşağıdaki kodda hata alıyorum.
ActiveWorkbook.Worksheets("EBAT LİSTELERİ").Sort.SortFields.Clear

Aşağıdaki dosyayı denermisiniz. Bende hata vermiyor. Hata veren dosyayı eklerseniz inceleriz.

 

[Metin55]

Sayın Vardar sizin dosya bende hata verdi

 

[Metin55]

Sayın Vardar ilgi ve alakanız için çok teşekkür ederim.Sizden son olarak asıl dosyamdaki kodda şöyle bir değişiklik yapmanız mümkünmüdür.Kayıt butonuna bastığımda kutucuğa Sayfa1(m3) sayfasındaki c5 hücresindeki istif numarası geliyor.Okeye bastığımda dosyanın tümü D sürücüsüne bu isimle kayıt yapılıyor.Benim yapmak istediğim dosyanın tümünü değilde sadece d klasörünün içerisine c5 hücresindeki istif numarası adıyla Sayfa1(m3) adlı sayfanın kayıt yapılabilmesi.Bu sorunuda halledebilirseniz size minnettar kalırım.Saygılar.

 

[vardar07]

Sayın Vardar aşağıdaki kodda hata alıyorum.
ActiveWorkbook.Worksheets("EBAT LİSTELERİ").Sort.SortFields.Clear

Sayın ormann aşağıdaki mesajlar size mi ait.

Sayın Vardar sizin dosya bende hata verdi

Sayın Vardar ilgi ve alakanız için çok teşekkür ederim.Sizden son olarak asıl dosyamdaki kodda şöyle bir değişiklik yapmanız mümkünmüdür.Kayıt butonuna bastığımda kutucuğa Sayfa1(m3) sayfasındaki c5 hücresindeki istif numarası geliyor.Okeye bastığımda dosyanın tümü D sürücüsüne bu isimle kayıt yapılıyor.Benim yapmak istediğim dosyanın tümünü değilde sadece d klasörünün içerisine c5 hücresindeki istif numarası adıyla Sayfa1(m3) adlı sayfanın kayıt yapılabilmesi.Bu sorunuda halledebilirseniz size minnettar kalırım.Saygılar.

Eğer size ait veya değilse siz veya Metin55 arkadaş dosya içi sayfayı farklı kaydetme başlığı altında yeni konu açarak yardım almayı deneyiniz. Bende kısıtlı bilgilerimle anca bu kadar yardımcı olabilirim. Kolay gelsin.