Merhaba textbox1 e sayfa11 den sayfa3 ye veri alıyorum kodlarda sorun yok ama ben sadece istediğim sütunların gelmesini istiyorum yani sayfa11 den sayfa3 ye tümü değil de
A D E F I J K L M N Osütunu gelmesini istiyorum ne yapmalıyım ;kodlar
Sub parçala()
TextBox1 = ""
ZBasla = TimeValue(Now)
zaman = Timer
For a = 2 To [S65536].End(xlUp).Row
If Cells(a, 19) <> "" Then TextBox1 = Trim(TextBox1 & " " & Cells(a, 19))
Next a
Application.ScreenUpdating = False
Sayfa11.Range("A2:O" & Rows.Count).ClearContents
Dim mesaj$
mesaj = "Islem Tamamlandi."
If Me.TextBox1.Text <> Empty Then
'Dim i As Long
Dim son_satir&, bul As Range, ilk_adres$, silinecekler As Range
'a = Split(Replace(TextBox1.Text, " ", ""), ",")'
a = Split(Trim(TextBox1.Text), " ")
For s = LBound(a) To UBound(a)
Set bul = Sayfa3.Columns("G").Find(a(s), , , xlPart)
If Not bul Is Nothing Then
ilk_adres = bul.Address
Set silinecekler = bul
Do
Set silinecekler = Union(silinecekler, bul)
son_satir = Cells(Rows.Count, 1).End(3).Row + 1
Range("A" & son_satir & ":M" & son_satir).Value = Sayfa3.Range("A" & bul.Row & ":M" & bul.Row).Value
Set bul = Sayfa3.Columns("G").FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> ilk_adres
'silinecekler.EntireRow.Delete
Else
mesaj = "Aranan DEĞER"
End If
Next s
Set bul = Nothing: son_satir = Empty: ilk_adres = Empty: Set silinecekler = Nothing
End If
Application.ScreenUpdating = True
MsgBox mesaj, vbInformation, "BILGI"
mesaj = Empty
'TextBox1.Text = Empty
Application.ScreenUpdating = True
zBitis = TimeValue(Now)
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"
End Sub
bu kodlarla tüm dolu satırlar geliyor..
not: örnek dosyada sayfa adları örnektir kodlardaki sayfa adları doğru.
http://s3.dosya.tc/server6/9gr41g/VERI_.rar.html
A D E F I J K L M N Osütunu gelmesini istiyorum ne yapmalıyım ;kodlar
Sub parçala()
TextBox1 = ""
ZBasla = TimeValue(Now)
zaman = Timer
For a = 2 To [S65536].End(xlUp).Row
If Cells(a, 19) <> "" Then TextBox1 = Trim(TextBox1 & " " & Cells(a, 19))
Next a
Application.ScreenUpdating = False
Sayfa11.Range("A2:O" & Rows.Count).ClearContents
Dim mesaj$
mesaj = "Islem Tamamlandi."
If Me.TextBox1.Text <> Empty Then
'Dim i As Long
Dim son_satir&, bul As Range, ilk_adres$, silinecekler As Range
'a = Split(Replace(TextBox1.Text, " ", ""), ",")'
a = Split(Trim(TextBox1.Text), " ")
For s = LBound(a) To UBound(a)
Set bul = Sayfa3.Columns("G").Find(a(s), , , xlPart)
If Not bul Is Nothing Then
ilk_adres = bul.Address
Set silinecekler = bul
Do
Set silinecekler = Union(silinecekler, bul)
son_satir = Cells(Rows.Count, 1).End(3).Row + 1
Range("A" & son_satir & ":M" & son_satir).Value = Sayfa3.Range("A" & bul.Row & ":M" & bul.Row).Value
Set bul = Sayfa3.Columns("G").FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> ilk_adres
'silinecekler.EntireRow.Delete
Else
mesaj = "Aranan DEĞER"
End If
Next s
Set bul = Nothing: son_satir = Empty: ilk_adres = Empty: Set silinecekler = Nothing
End If
Application.ScreenUpdating = True
MsgBox mesaj, vbInformation, "BILGI"
mesaj = Empty
'TextBox1.Text = Empty
Application.ScreenUpdating = True
zBitis = TimeValue(Now)
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla), vbInformation, " Sonuç Penceresi"
End Sub
bu kodlarla tüm dolu satırlar geliyor..
not: örnek dosyada sayfa adları örnektir kodlardaki sayfa adları doğru.
http://s3.dosya.tc/server6/9gr41g/VERI_.rar.html
Son düzenleme:
