• DİKKAT

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

Başka Sayfadan Veri Alımı

T

topcuexcel

Katılım
20 Kasım 2010
Mesajlar
62
Excel Vers. ve Dili
Excel 2007 - Excel 2010 TÜRKÇE
Kod:
Private Sub CommandButton1_Click()
i = Find(TextBox9.Text).Row

Cells(i, 3) = ComboBox1
Cells(i, 4) = TextBox1.Value
Cells(i, 19) = ComboBox4
Cells(i, 20) = ComboBox6
Cells(i, 21) = ComboBox5
Cells(i, 22) = ComboBox9
Cells(i, 23) = ComboBox7
Cells(i, 24) = ComboBox8
Cells(i, 26) = TextBox15
Cells(i, 27) = TextBox16


Call YAZDIR
Call AKTAR

End Sub
Kod:

Merhabalar
Bu kod çalışıyor fakat çalışma sayfam farklı olduğu için hata veriyor. Bende foruma bakarak aşağıdaki gibi bir kod denedim fakat olmuyor yardım edebilir misiniz?

Kod:
Private Sub CommandButton1_Click()


With Sheets("ÜRETİM PLANI 2011 F-E01-20")
For Each ara In .Range("A2:A" & Sheets("ÜRETİM PLANI 2011 F-E01-20").Range("A65536").End(3).Row)
i = ara.Find(TextBox9.Text).Row

Cells(i, 3) = ComboBox1
Cells(i, 4) = TextBox1.Value
Cells(i, 19) = ComboBox4
Cells(i, 20) = ComboBox6
Cells(i, 21) = ComboBox5
Cells(i, 22) = ComboBox9
Cells(i, 23) = ComboBox7
Cells(i, 24) = ComboBox8
Cells(i, 26) = TextBox15
Cells(i, 27) = TextBox16
Next ara
End With

Call YAZDIR
Call AKTAR


End Sub
 
Aşağıdaki gibi deneyin.

Kod: 
Private Sub CommandButton1_Click()
Set s1 = Sheets("ÜRETİM PLANI 2011 F-E01-20")
sonsat = s1.Range("A65536").End(3).Row
say = WorksheetFunction.CountIf(s1.Range("A2:A" & sonsat), TextBox9.Text)

If say = 0 Then Exit Sub
i = WorksheetFunction.Match(TextBox9.Text, s1.Range("A2:A" & sonsat), 0)

Cells(i, 3) = ComboBox1
Cells(i, 4) = TextBox1.Value
Cells(i, 19) = ComboBox4
Cells(i, 20) = ComboBox6
Cells(i, 21) = ComboBox5
Cells(i, 22) = ComboBox9
Cells(i, 23) = ComboBox7
Cells(i, 24) = ComboBox8
Cells(i, 26) = TextBox15
Cells(i, 27) = TextBox16

Call YAZDIR
Call AKTAR
End Sub
 
Levent Bey Teşekkürler...
denedim ama olmuyor!!
 
topcuexcel' Alıntı:
Levent Bey Teşekkürler...
denedim ama olmuyor!!
Genişletmek için tıkla ...

i = WorksheetFunction.Match(TextBox9.Text, s1.Range("A2:A" & sonsat), 0)

yukarıdaki kodları aşağıdaki ile değiştirip denermisiniz.

Aranan=TextBox9.Text
set i=s1.Range("A2:A" & sonsat).Find(What:=Aranan, LookAt:=xlWhole).Row
 
Son düzenleme:
Hüseyin Bey aşağıdaki hatayı veriyor,
Run Time Error '13':
Type mismatch
 
Hüseyin Bey,
Dediğinizi yaptım fakat hiç bir şey olmadı ne hata veriyor ne de işlemi yapıyor
 
Hüseyin Bey Teşekkürler oldu aktarmayı yapıyor.
Fakat çalışma sayfasında tuşa bağlı olan ve çalışan YAZDIR makrosu Userformda çalışmıyor.
Sanırım Userformu başka sayfaya alıp açtığımdan gene aktarmadaki gibi bu da çalışmıyor.

Kod: 
Sub YAZDIR()

Sheets("DEPO ÇIKIŞ İŞ EMRİ F-E01-2").Cells(1, 3) = ""

i = 3
Do Until Sheets("ÜRETİM PLANI 2011 F-E01-20").Cells(i, 2) = ""
i = i + 1
Loop

Sheets("DEPO ÇIKIŞ İŞ EMRİ F-E01-2").Cells(1, 3) = Sheets("ÜRETİM PLANI 2011 F-E01-20").Cells(i - 1, 1)

If Cells(i - 1, 10) = "TES" Then
Sheets("DEPO ÇIKIŞ İŞ EMRİ F-E01-2").PrintOut
Sheets("TESTERE İŞ EMRİ F-E01-3").PrintOut
End If
If Cells(i - 1, 10) = "İNDEX" Then
Sheets("DEPO ÇIKIŞ İŞ EMRİ F-E01-2").PrintOut
Sheets("İNDEX İŞ EMRİ F-E01-5").PrintOut
End If
If Cells(i - 1, 10) = "CNC" Then
Sheets("CNC İŞ EMRİ F-E01-18").PrintOut
End If

If Cells(i - 1, 11) = "PRES" Then
Sheets("PRESHANE İŞ EMRİ F-E01-4").PrintOut
End If
If Cells(i - 1, 11) = "KÜRE" Then
Sheets("KÜRE İŞ EMRİ F-E01-8").PrintOut
End If
If Cells(i - 1, 11) = "KAP" Then
Sheets("KAPLAMA İŞ EMRİ F-E01-19").PrintOut
End If

If Cells(i - 1, 12) = "CNC" Then
Sheets("CNC İŞ EMRİ F-E01-18").PrintOut
End If
If Cells(i - 1, 12) = "KAP" Then
Sheets("KAPLAMA İŞ EMRİ F-E01-19").PrintOut
End If
If Cells(i - 1, 12) = "TRS" Then
Sheets("TRANSFER İŞ EMRİ F-E01-17").PrintOut
End If
If Cells(i - 1, 12) = "ROV" Then
Sheets("ROVELVER İŞ EMRİ F-E01-16").PrintOut
End If
If Cells(i - 1, 12) = "KÜRE" Then
Sheets("KÜRE İŞ EMRİ F-E01-8").PrintOut
End If

If Cells(i - 1, 13) = "KAP" Then
Sheets("KAPLAMA İŞ EMRİ F-E01-19").PrintOut
End If
If Cells(i - 1, 13) = "ROV" Then
Sheets("ROVELVER İŞ EMRİ F-E01-16").PrintOut
End If
If Cells(i - 1, 13) = "CNC" Then
Sheets("CNC İŞ EMRİ F-E01-18").PrintOut
End If

If Cells(i - 1, 14) = "KAP" Then
Sheets("KAPLAMA İŞ EMRİ F-E01-19").PrintOut
End If

End Sub
 
kardeşim sizlerin nasıl emegı ödenir.bu ne harıka şey böyle helal olsun bana lazım olmayan bir makro ama gercekten emegınıze saygı duyuyorum helal olsun
 
Hüseyin Bey yardımlarınız için çok teşekkür ederim...
Ben sizin çözümünüz deki gibi "set" kullanarak kendi problemimi çözebildim sağolun...
Kod: 
Sub yazdır()


Set s1 = Sheets("DEPO ÇIKIŞ İŞ EMRİ F-E01-2")
Set s2 = Sheets("ÜRETİM PLANI 2011 F-E01-20")
Set s3 = Sheets("TESTERE İŞ EMRİ F-E01-3")
Set s4 = Sheets("İNDEX İŞ EMRİ F-E01-5")
Set s5 = Sheets("CNC İŞ EMRİ F-E01-18")
Set s6 = Sheets("PRESHANE İŞ EMRİ F-E01-4")
Set s7 = Sheets("KÜRE İŞ EMRİ F-E01-8")
Set s8 = Sheets("KAPLAMA İŞ EMRİ F-E01-19")
Set s9 = Sheets("TRANSFER İŞ EMRİ F-E01-17")
Set s10 = Sheets("ROVELVER İŞ EMRİ F-E01-16")


s1.Cells(1, 3) = ""

i = 3
Do Until s2.Cells(i, 2) = ""
i = i + 1
Loop

s1.Cells(1, 3) = s2.Cells(i - 1, 1)

If s2.Cells(i - 1, 10) = "TES" Then
s1.PrintOut
s3.PrintOut
End If
If s2.Cells(i - 1, 10) = "İNDEX" Then
s1.PrintOut
s4.PrintOut
End If
If s2.Cells(i - 1, 10) = "CNC" Then
s5.PrintOut
End If

If s2.Cells(i - 1, 11) = "PRES" Then
s6.PrintOut
End If
If s2.Cells(i - 1, 11) = "KÜRE" Then
s7.PrintOut
End If
If s2.Cells(i - 1, 11) = "KAP" Then
s8.PrintOut
End If

If s2.Cells(i - 1, 12) = "CNC" Then
s5.PrintOut
End If
If s2.Cells(i - 1, 12) = "KAP" Then
s8.PrintOut
End If
If s2.Cells(i - 1, 12) = "TRS" Then
s9.PrintOut
End If
If s2.Cells(i - 1, 12) = "ROV" Then
s10.PrintOut
End If
If s2.Cells(i - 1, 12) = "KÜRE" Then
s7.PrintOut
End If

If s2.Cells(i - 1, 13) = "KAP" Then
s8.PrintOut
End If
If s2.Cells(i - 1, 13) = "ROV" Then
s10.PrintOut
End If
If s2.Cells(i - 1, 13) = "CNC" Then
s5.PrintOut
End If

If s2.Cells(i - 1, 14) = "KAP" Then
s8.PrintOut
End If


End Sub
 
Üretim ile ilgili dosyanın tamamlanmış halini ekleyebilirmisiniz acaba?
Benimde böyle bir programa ihtiyacım var.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst