Bu konuda yardımınızı bekliyorum. Açıklama dosya ekindedir. Teşekkür ederim Kolay gelsin.
Ekli dosyalar
-
110.5 KB Görüntüleme: 30
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
merhabaBu konuda yardımınızı bekliyorum. Açıklama dosya ekindedir. Teşekkür ederim Kolay gelsin.
Option Explicit
Private Sub CommandButton1_Click()
Dim ts, kaplan
kaplan = MsgBox(Sheets("Senet").Range("J2") & " Verilerini Aktarıyorum", _
vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
Sheets("Senet").Range("A14:J42").ClearContents
Sheets("Senet").Range("A54:J106").Delete
For ts = 2 To Sheets("Kart").Cells(65536, "L").End(xlUp).Row
If Sheets("Senet").Range("A43") = "" Then
If Sheets("Kart").Cells(ts, "L") = Sheets("Senet").Range("J2") Then
Sheets("Senet").Range("A43").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "A")
Sheets("Senet").Range("B43").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "K")
Sheets("Senet").Range("C43").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "G")
Sheets("Senet").Range("D43").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "C")
Sheets("Senet").Range("E43").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "E") & " " & Sheets("Kart").Cells(ts, "F")
Sheets("Senet").Range("J43").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "H")
End If
Else
Sheets("Senet").Range("A1:J53").Copy
Sheets("Senet").Range("A54").PasteSpecial
Application.CutCopyMode = False
Sheets("Senet").Range("A67:J96").ClearContents
Sheets("Senet").Range("A96").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "A")
Sheets("Senet").Range("B96").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "K")
Sheets("Senet").Range("C96").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "G")
Sheets("Senet").Range("D96").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "C")
Sheets("Senet").Range("E96").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "E") & " " & Sheets("Kart").Cells(ts, "F")
Sheets("Senet").Range("J96").End(xlUp).Offset(1, 0) = Sheets("Kart"). _
Cells(ts, "H")
End If
Next
MsgBox Sheets("Senet").Range("J2") & " Verilerini Aktardım", _
vbInformation, "Bitiş"
End Sub
üstteki kod'u güncelledim.İhsan Bey Merhaba
Gönderdiğiniz kodu SENET AL butonuna kopyaladım ancak Run-time error '1004' hatası verdi.
Düzeltmeye uğraştım ama proğramı çalıştıramadım.
Birde siz denermisiniz hatayı görme açısından SENET AL butonuna basınca çalışması lazım.
İlginize teşekkürler.Allah Razı Olsun
merhabaSevgili İhsan hocam öncelikle Cumanız mübarek olsun
Excell konusunda cahilliğime verin lütfen bir türlü beceremedim. Son güncellediğiniz koduda çalıştıramadım.
1.sayfayı yazıyor 2. sayfaya gelince ilk satırını yazıyor devamını yazmıyor.
Mesela her sayfa 30 satır 1. sayfada 30 satırı yazıyor 2. sayfada 31. satırı yazıyor 32. satıra geçmiyor. 40 tane malzeme girildiyse 31 tanesini görebiliyorum.
Ekteki dosyada hazırladım. örnek: U8 numarasını yazdığımda 60 tane malzemeyi bilgileri ile göstermesi lazım.
Bilmem anlatabildimmi. Teşekkürler ederim.
rica ederimüstadım şimdi oldu. Hemde çok güzel olmuş.zahmet verdim teşekkür ederim hakkını helal et.