1. sayfaya girilen verileri, 2. sayfadaki ilgili kutulara kaydetme

[afsahiner]

Merhaba saygıdeğer üstadlarım,

Ekte önceden yapılmış bir çalışma var burda ilk sayfaya girdiğimiz verileri kaydet tuşuyla tek tıkla 2. sayfaya kaydediyor idik ancak bilgilerden herhangi biri girilmediğinde bilgiler 2. sayfaya bir sütun kayarak kaydediliyordu, herhangi bir kayma olmadan ilk sayfada boş olanları da 2. sayfadaki yerine boş kaydetmek için kıymetli yardımlarınızı bekliyorum. Birde 2. sayfayı kullanıcıların sadece görüntülemesi değişiklik yapamaması için güvenlik koymak istedim ancak bu deferde makro çalışmadı bu konuda da yardım edebilirseniz çok sevinirim. Herkese iyi çalışmalar.

 

[YUSUF44]

Şöyle yaparsanız olur bence:

Öncelikle Firma bilgileri sayfasında 13. ve 18. satırlarda yer alan açıklama ve ödeme satırlarını aradan çıkarmanız gerekiyor ki tablonuz başından sonuna tek tablo olsun.

Daha sonra Deneme makrosunu aşağıdaki gibi değiştirirseniz istediğiniz olur:

Sub deneme()

Range("B2:B23").Select
    Selection.Copy
Sheets("TEDARİKÇİ DATASI").Select
    Set c = [b:b].Find("")
If Not c Is Nothing Then c.Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Application.CutCopyMode = False
    Set d = [b:b].Find("")
If Not d Is Nothing Then d.Select
    Sheets("FIRMA BILGILERI").Select
  
    Application.CutCopyMode = False
    Range("B2").Select
MsgBox ("GIRIS YAPILMISTIR")
End Sub

Tabi bunu aradaki satırları çıkarmayarak da yapabilirsiniz muhtemelen (beni aşar) ama en pratik yöntem bence budur.

 

[afsahiner]

Teşekkür ederim Yusuf Bey, güvenlikle ilgili tavsiyeniz varmı

 

[YUSUF44]

Önemli değil.

Güvenlikten kastınız nedir?

 

[afsahiner]

2. sayfayı kullanıcıların sadece görüntülemesi değişiklik yapamaması için güvenlik koymak istedim ancak bu deferde makro çalışmadı bu konuda da yardım edebilirseniz çok sevinirim. Herkese iyi çalışmalar.

 

[aseymen]

Birde 2. sayfayı kullanıcıların sadece görüntülemesi değişiklik yapamaması için güvenlik koymak istedim ancak bu deferde makro çalışmadı bu konuda da yardım edebilirseniz çok sevinirim.

sanırım arkadaş data kısmına, yani ikinci sayfaya password ile korumaya almak istiyor.

 

[YUSUF44]

deneme makrosunu şöyle kullanırsanız, her veri girişinden sonra sayfayı korumaya alır:

Sub deneme()

Range("B2:B23").Select
    Selection.Copy
Sheets("TEDARİKÇİ DATASI").Select
      ActiveSheet.Unprotect
    Set c = [b:b].Find("")
If Not c Is Nothing Then c.Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Application.CutCopyMode = False
    Set d = [b:b].Find("")
If Not d Is Nothing Then d.Select
          ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
     
    Sheets("FIRMA BILGILERI").Select
  
    Application.CutCopyMode = False
    Range("B2").Select
MsgBox ("GIRIS YAPILMISTIR")
End Sub

 

[YUSUF44]

Yada aşağıdaki makroları kullanırsanız tedarikçi sayfasını gizler, veri girişlerinde açar, başka zaman sayfa görünmez. Burda şifreyi 12345 olarak ayarladım.Her seferinde o şifreyi girmeniz gerekeceği için kullanışlı olmaz. Başka türlü sayfaya şifre koymayı bulamadım.

Sub deneme()

Range("B2:B23").Select
    Selection.Copy
Sheets("TEDARİKÇİ DATASI").Select
      Call SayfaAç
    Set c = [b:b].Find("")
If Not c Is Nothing Then c.Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Application.CutCopyMode = False
    Set d = [b:b].Find("")
If Not d Is Nothing Then d.Select
         Call Gizle
     
    Sheets("FIRMA BILGILERI").Select
  
    Application.CutCopyMode = False
    Range("B2").Select
MsgBox ("GIRIS YAPILMISTIR")
End Sub

Sub SayfaAç()
Şifre = InputBox("Lütfen şifrenizi giriniz.")
If Şifre <> "12345" Then
MsgBox "Geçersiz şifre girdiniz."
Exit Sub
Else:
Sheets("TEDARİKÇİ DATASI").Visible = xlSheetVisible
End If
End Sub

Sub Gizle()
Sheets("TEDARİKÇİ DATASI").Visible = xlSheetVeryHidden
End Sub

 

[SaLLaNaNLaMBa]

sorgula-bul-kayset-

Merhabalar,
Firma dosyalarına göre sorgulama yapıp, her dosyanın akıbetine göre açıklama yapacağım,
Örneğin makbuz geldi ve bu 11 nolu dosyaya aitse, referansa 11 yazıp sorgulayıp, makbuz geldi diyeyazıp kaydettiğimde 11. Nolu sayfada kayıt olacak ve ben 11 nolu referansı sorguladığımda gelecek,

 

[SaLLaNaNLaMBa]

Günaydınlar,
bakabilen oldu mu?

 

[YUSUF44]

Aktarmak için aşağıdaki makroyu bir modüle kopyalayıp deneyiniz:

Sub AKTAR()
Set s1 = Sheets("SORGULAMA")
referans = s1.[B2]
veri = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "A").End(3).Row)
For sayfa = 1 To Sheets.Count
    If Sheets(sayfa).Name = WorksheetFunction.Text(referans, "0") Then
        yeni = WorksheetFunction.Max(2, Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row + 1)
        s1.Range("A4:B" & veri).Copy Sheets(sayfa).Cells(yeni, "A")
    End If
Next

End Sub

Sorgulamak için aşağıdaki makroyu mir modüle kopyalayıp deneyiniz:

Sub SORGULA()
Set s1 = Sheets("SORGULAMA")
referans = s1.[B2]
eski = WorksheetFunction.Max(4, s1.Cells(Rows.Count, "A").End(3).Row)
s1.Range("A4:B" & eski).ClearContents
For sayfa = 1 To Sheets.Count
    If Sheets(sayfa).Name = WorksheetFunction.Text(referans, "0") Then
        son = WorksheetFunction.Max(2, Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row)
        Sheets(sayfa).Range("A2:B" & son).Copy s1.[A4]
    End If
Next

End Sub

 

[SaLLaNaNLaMBa]

Yusuf Bey çoook teşekkür ederim fakat çalıştırmadım ,

excell dosyasına ekleyip örnek dosyayı gönderebilir misiniz.

 

[YUSUF44]

Dosya açıkken Alt+F11 yapın
Açılan sayfada Insert menüsünden Module'yi seçin
Burdaki her iki kodu da açılan boş sayfaya yapıştırın
Excel dosyasına geçin
Sorgulama sayfasında iki tane düğme eklemişsiniz o düğmelere sağ tıklayıp ilgili makroları atayın

 

[SaLLaNaNLaMBa]

çok teşekkür ederim çalıştı