• DİKKAT

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

birden cok nesneyi (mesel(48) bir baska sayda aynuı sutuna aktarma

Katılım
25 Aralık 2007
Mesajlar
335
Excel Vers. ve Dili
exel 2000 türkçe
arkadaslPrivate Sub CommandButton54_Click()
Dim sat As Long, k As Range
If TextBox1.Value = "" Then
MsgBox "Kod boş olamaz..!!", vbCritical, "DİKKAT"

Exit Sub
End If
Set k = Sheets("KODLAR").Range("B2:B65536").Find(TextBox1.Value, , xlValues, xlWhole)
If k Is Nothing Then
sat = Sheets("KODLAR").Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65534 Then
MsgBox "Satır doldu..!!" & vbLf & "Yeni kayıt yapamazsınız..!!", vbCritical, "SATIR DOLDU"
Exit Sub
End If
With Sheets("KODLAR")
.Cells(sat, "B").Value = TextBox1.Value
.Cells(sat, "b").Value = TextBox2.Value
.Cells(sat, "b").Value = TextBox3.Value
.Cells(sat, "b").Value = TextBox4.Value
.Cells(sat, "b").Value = TextBox5.Value
.Cells(sat, "b").Value = TextBox6.Value
.Cells(sat, "b").Value = TextBox7.Value
.Cells(sat, "b").Value = TextBox8.Value
.Cells(sat, "b").Value = TextBox9.Value
.Cells(sat, "b").Value = TextBox10.Value
.Cells(sat, "b").Value = TextBox11.Value
.Cells(sat, "b").Value = TextBox12.Value
.Cells(sat, "b").Value = TextBox13.Value
.Cells(sat, "b").Value = TextBox14.Value
.Cells(sat, "b").Value = TextBox15.Value
.Cells(sat, "b").Value = TextBox16.Value
.Cells(sat, "b").Value = TextBox17.Value
.Cells(sat, "b").Value = TextBox18.Value
.Cells(sat, "b").Value = TextBox19.Value
.Cells(sat, "b").Value = TextBox20.Value
.Cells(sat, "b").Value = TextBox21.Value
.Cells(sat, "b").Value = TextBox22.Value
.Cells(sat, "b").Value = TextBox23.Value
.Cells(sat, "b").Value = TextBox24.Value
.Cells(sat, "b").Value = TextBox25.Value
.Cells(sat, "b").Value = TextBox26.Value
.Cells(sat, "b").Value = TextBox27.Value
.Cells(sat, "b").Value = TextBox28.Value
.Cells(sat, "b").Value = TextBox29.Value
.Cells(sat, "b").Value = TextBox30.Value
.Cells(sat, "b").Value = TextBox31.Value
.Cells(sat, "b").Value = TextBox32.Value
.Cells(sat, "b").Value = TextBox33.Value
.Cells(sat, "b").Value = TextBox34.Value
.Cells(sat, "b").Value = TextBox35.Value
.Cells(sat, "b").Value = TextBox36.Value
.Cells(sat, "b").Value = TextBox37.Value
.Cells(sat, "b").Value = TextBox38.Value
.Cells(sat, "b").Value = TextBox39.Value

End With
Else
If MsgBox("KOD : " & TextBox1.Value & " Daha önceden girilmiş..!!" & vbLf _
& "Üstüne Kaydetmek istiyormusunuz??", vbYesNo + vbQuestion, "DİKKAT") = vbNo Then
Exit Sub
End If
With Sheets("KODLAR")
.Cells(k.Row, "b").Value = TextBox2.Value
.Cells(k.Row, "b").Value = TextBox3.Value
.Cells(k.Row, "b").Value = TextBox4.Value
.Cells(k.Row, "b").Value = TextBox5.Value
.Cells(k.Row, "b").Value = TextBox6.Value
.Cells(k.Row, "b").Value = TextBox7.Value
.Cells(k.Row, "b").Value = TextBox8.Value
.Cells(k.Row, "b").Value = TextBox9.Value
.Cells(k.Row, "b").Value = TextBox10.Value
.Cells(k.Row, "b").Value = TextBox11.Value
.Cells(k.Row, "b").Value = TextBox12.Value
.Cells(k.Row, "b").Value = TextBox13.Value
.Cells(k.Row, "b").Value = TextBox14.Value
.Cells(k.Row, "b").Value = TextBox15.Value
.Cells(k.Row, "b").Value = TextBox16.Value
.Cells(k.Row, "b").Value = TextBox17.Value
.Cells(k.Row, "b").Value = TextBox18.Value
.Cells(k.Row, "b").Value = TextBox19.Value
.Cells(k.Row, "b").Value = TextBox20.Value
.Cells(k.Row, "b").Value = TextBox21.Value
.Cells(k.Row, "b").Value = TextBox22.Value
.Cells(k.Row, "b").Value = TextBox23.Value
.Cells(k.Row, "b").Value = TextBox24.Value
.Cells(k.Row, "b").Value = TextBox25.Value
.Cells(k.Row, "b").Value = TextBox26.Value
.Cells(k.Row, "b").Value = TextBox27.Value
.Cells(k.Row, "b").Value = TextBox28.Value
.Cells(k.Row, "b").Value = TextBox29.Value
.Cells(k.Row, "b").Value = TextBox30.Value
.Cells(k.Row, "b").Value = TextBox31.Value
.Cells(k.Row, "b").Value = TextBox32.Value
.Cells(k.Row, "b").Value = TextBox33.Value
.Cells(k.Row, "b").Value = TextBox34.Value
.Cells(k.Row, "b").Value = TextBox35.Value
.Cells(k.Row, "b").Value = TextBox36.Value
.Cells(k.Row, "b").Value = TextBox37.Value
.Cells(k.Row, "b").Value = TextBox38.Value
.Cells(k.Row, "b").Value = TextBox39.Value

End With
End If
MsgBox "Kayıt Girildi..!!", vbOKOnly + vbInformation, "KAYIT"
End Subar
bu kodu nasıl degiştirmeliyim ki butun textboxları sırasını sasırmadan aynı sutuna kopyalasın
birde bu textboxlar sadece 1 sutuna ait ve bunun gibi altı sutun daha var koplayanacak bundan bi sorun cıkarmı
 
Geri
Üst