• DİKKAT

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

bekleyen sipariş

  • Konbuyu başlatan Konbuyu başlatan piyers
  • Başlangıç tarihi Başlangıç tarihi
Evren Gizlen
eline sağlık çok güzel buda işime yarar bir program
 
Son düzenleme:
İstediğinizin doğru bir şekilde olabilmesi için,Verileriniz bu yolladığım dosya ile girmelisiniz.Çünkü bu dosyada ıd numarası veriliyor ve o ıd numarasaına göre diğer sayafada bulup tarihi düzeltiyor.Aksi takdirde hatalı sonuçlar üretebilirdi.
Tarih girişinide tarih sekmesinden listeden istediğiniz,satırı seçip tarihi değiştirebilirsiniz.Listeden seçtiğiniz tarih Sayfasındaki tarihi değiştirir.:cool:
Bu dosyada bir eksiklik varsa onu yazababilirsiniz.:cool:
 
Evren Gizlen

bu dosyaya göre ayarlama yapacağım



saygılarımla
 
Son düzenleme:
piyers' Alıntı:
Evren Gizlen

bu dosyaya göre ayarlam yapacağım

bana gönderdiğin makro ve bilgiler için size çok teşekkür ederim
ellerinize sağlık sağolun

saygılarımla
Genişletmek için tıkla ...

Değişiklik yapmanız gerekirse veya eklenecek bir şey olursa yazarsınız.
İyi çalışmalar.:cool:
Hatırlatma : Dosyaya verilerinizi UserformDan giriniz.:cool:
 
yardım

Evren arkadaş

selam sizden bir ricam olacak ekteki dosyayı kullanmaya karar verdik ama bekleyen siparişler bolumundeki tarih kısmına tarihi yazım butona basınca
bilgileri makina 1 ise makina 1 e makina 2 ise makina 2 atıyor ama bekleyen siparişler de o attığı satırlar kalıyor sizden ricam butona bastığım zaman tarih yazan satırları atsın tarih yazmayan satırları atmasın bu makroyu bana gönderirseniz sevinirim.

saygılarımla
 
Sayfalara atılan satırlar Bekleyenler sayfasından silinsinmi istiyorsunuz?:cool:
 
piyers' Alıntı:
evet bekleyen siparişler de silinsin istiyorum
Genişletmek için tıkla ...

Dosyanız hazır.:cool:
Kod: 
Sub aktar()
Dim sat As Long, i As Long, k As Integer
Sheets("BEKLEYEN SİPARİŞLER").Select
Application.ScreenUpdating = False
For i = Cells(65536, "B").End(xlUp).Row To 6 Step -1
    If Left(LCase(Replace(Replace(Trim(Cells(i, "L").Value), "I", "I"), "İ", "i")), 6) = "makina" Then
        On Error GoTo atla
        adr1 = Range(Cells(i, "B"), Cells(i, "L")).Address
        sat = Sheets(Cells(i, "L").Value).Cells(65536, "B").End(xlUp).Row + 1
        adr2 = Range(Cells(sat, "B"), Cells(sat, "L")).Address
        Sheets(Cells(i, "L").Value).Range(adr2).Value = Range(adr1).Value
        Range(adr1).Delete (xlUp)
atla:
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub
 
Evren ArkadaŞ
Tarİh GİrmedİĞİm Satirlarida GÖnderİyor
Tarİh GİrmedİĞİm Satirlar Gİtmesİn
 
piyers' Alıntı:
Evren ArkadaŞ
Tarİh GİrmedİĞİm Satirlarida GÖnderİyor
Tarİh GİrmedİĞİm Satirlar Gİtmesİn
Genişletmek için tıkla ...
Dosyanız hazır.:cool:
Kod: 
Sub aktar()
Dim sat As Long, i As Long, k As Integer
Sheets("BEKLEYEN SİPARİŞLER").Select
Application.ScreenUpdating = False
For i = Cells(65536, "B").End(xlUp).Row To 6 Step -1
    If Cells(i, "K").Value = "" Then GoTo atla
    If Left(LCase(Replace(Replace(Trim(Cells(i, "L").Value), "I", "I"), "İ", "i")), 6) = "makina" Then
        On Error GoTo atla
        adr1 = Range(Cells(i, "B"), Cells(i, "L")).Address
        sat = Sheets(Cells(i, "L").Value).Cells(65536, "B").End(xlUp).Row + 1
        adr2 = Range(Cells(sat, "B"), Cells(sat, "L")).Address
        Sheets(Cells(i, "L").Value).Range(adr2).Value = Range(adr1).Value
        Range(adr1).Delete (xlUp)

    End If
atla:
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub
 
bir konuda daha yardımcı olanızı isterim

evren arkadaş
sizden bir ricam olacak
ben bir kayan yazı makrosunu düzeltmek istiyorum yardımcı olursanız sevinirim
makroyu çalıştırarak çalısıyor ben ekcel sayfasını açtığım zaman çalışsın
yani makroyu hangi sayfa için yapmışsam o sayfayı acınca çalışsın dirkt olark

bunu ayarlaya bilirmisiniz

teşekkürler
 
Dosyanız hazır.:cool:
 
evren arkadaş
sizden bir ricam olacak
sizede cok yüklendik ama

size ekte bir dosya gönderdim
bakarsanız sevinirim.

saygılarımla
 
piyers' Alıntı:
evren arkadaş
sizden bir ricam olacak
sizede cok yüklendik ama

size ekte bir dosya gönderdim
bakarsanız sevinirim.

saygılarımla
Genişletmek için tıkla ...
Dosyanız hazır Makina adı bölümüne x işaretini ilgili makinanın yanındaki hücreye koymayı unutmayınız..:cool:
Kod: 
Sub makina_aktar()
Dim sat As Long
Sheets("SİPARİŞ FORMU").Select
Set s2 = Sheets("BEKLEYEN SİPARİŞLER")
sat = s2.Cells(65536, "B").End(xlUp).Row + 1
If sat > 65533 Then
    MsgBox "BEKLEYEN SİPARİŞLER SAYFASI Satırları doldu.." & vbLf & _
    "Başka kayıt yapamazsınız..!!", vbCritical, "DİKKAT"
End If
For k = 3 To 9 Step 6
    If Cells(8, k).Value = "" Or Cells(10, k).Value = "" Or Cells(33, k).Value _
    = "" And Cells(33, k + 2).Value = "" Then
        MsgBox Cells(8, k).Address & " Adresinde veya " & _
        vbLf & Cells(10, k).Address & " Adresindeki hücreler boş olduğundan " _
        & "YADA MAKİNA ismi seçilmediğinden Dolayı..!!" & _
        vbLf & k & " sütünundaki veriler kayıt edilmedi..!!", vbCritical, "DİKKAT"
        GoTo atla
    End If
    s2.Cells(sat, "B").Value = Cells(10, k).Value
    s2.Cells(sat, "C").Value = Cells(12, k).Value
    s2.Cells(sat, "D").Value = Cells(18, k).Value
    s2.Cells(sat, "E").Value = Cells(20, k).Value
    s2.Cells(sat, "F").Value = Cells(22, k).Value
    s2.Cells(sat, "G").Value = Cells(24, k).Value
    s2.Cells(sat, "H").Value = Cells(26, k).Value
    s2.Cells(sat, "K").Value = Cells(8, k).Value
    If Cells(33, k).Value = "X" Or Cells(33, k).Value = "x" Then
        s2.Cells(sat, "L").Value = Cells(33, k - 1).Value
        ElseIf Cells(33, k + 2).Value = "X" Or Cells(33, k + 2).Value = "x" Then
        s2.Cells(sat, "L").Value = Cells(33, k + 1).Value
    End If
    Range(Cells(8, k), Cells(30, k)) = Empty
    Range(Cells(36, k + 1), Cells(43, k + 1)) = Empty
    sat = sat + 1
atla:
Next
MsgBox "Kayıt Girldi..!!", vbOKOnly + vbInformation, Application.UserName
Set s2 = Nothing
End Sub
 
Evren Gizlen

dosyayı ekledim açıkla dosyada

bekleyen siparişler sayfasına gönderildiği zaman bu sayfada tarih ve makina bolumu boş kalsın

saygılarımla
 
Son düzenleme:
piyers' Alıntı:
Evren Gizlen

dosyayı ekledim açıkla dosyada

bekleyen siparişler sayfasına gönderildiği zaman bu sayfada tarih ve makina bolumu boş kalsın

saygılarımla
Genişletmek için tıkla ...

Dosyanız hazır.:cool:
Kod: 
Sub makina_aktar()
Dim sat As Long
Sheets("SİPARİŞ FORMU").Select
Set s2 = Sheets("BEKLEYEN SİPARİŞLER")
sat = s2.Cells(65536, "B").End(xlUp).Row + 1
If sat > 65533 Then
    MsgBox "BEKLEYEN SİPARİŞLER SAYFASI Satırları doldu.." & vbLf & _
    "Başka kayıt yapamazsınız..!!", vbCritical, "DİKKAT"
    Set s2 = Nothing
    Exit Sub
End If
    If Cells(10, "C").Value = "" Then
        MsgBox "Firma adı boş olamaz..!!" & _
        vbLf & " Veriler kayıt edilmedi..!!", vbCritical, "DİKKAT"
        Range("C10").Select
        Set s2 = Nothing
        Exit Sub
    End If
    s2.Cells(sat, "B").Value = Cells(10, "C").Value
    s2.Cells(sat, "C").Value = Cells(12, "C").Value
    s2.Cells(sat, "D").Value = Cells(18, "C").Value
    s2.Cells(sat, "E").Value = Cells(20, "C").Value
    s2.Cells(sat, "F").Value = Cells(22, "C").Value
    s2.Cells(sat, "G").Value = Cells(24, "C").Value
    s2.Cells(sat, "H").Value = Cells(26, "C").Value
    Range(Cells(8, "C"), Cells(30, "C")) = Empty
    Range(Cells(36, "D"), Cells(43, "D")) = Empty
MsgBox "Kayıt Girildi..!!", vbOKOnly + vbInformation, Application.UserName
Set s2 = Nothing
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst