Farklı sayfalardan koşula göre tek sayfaya kopyalama

[TheSmoke]

Merhaba arkadaşlar
Altın üyeliğim bittiği için dosya yükleyemedim. Kısaca şöyle anlatayım.
Ali, Ahmet ve Mehmet isimli 3 sayfam ve Siparişler isimli 1 sayfam var. Bu 3 sayfadaki 6. sütunlara "Sipariş" yazdığımda, "Sipariş" yazan satırları "Siparişler" sayfasına kopyalamasını istiyorum. "Sipariş" yazan hücreyi silince de "Siparişler" sayfasından silinmesini istiyorum. Aslında bu kodu Ali sayfasında aşağıdaki gibi yaptım. "Sipariş" yazdıklarım "Siparişler" sayfasına kopyalanıyor. Silersem "Siparişler" sayfasında siliniyor. Ama ben bunu 3 sayfa içinde kullanmak istiyorum. Acaba mümkün müdür? Yoksa aynı kodu 3 sayfaya ayrı ayrı girmem mi gerekiyor?

 

[catalinastrap]

Sub KopyalaSiparisler()
Dim ws As Worksheet
Dim siparislerWs As Worksheet
Dim lastRow As Long
Dim siparisRow As Long
Dim i As Long
Dim j As Long

On Error Resume Next
Set siparislerWs = Worksheets("Siparişler")
On Error GoTo 0
If siparislerWs Is Nothing Then
Set siparislerWs = Worksheets.Add
siparislerWs.Name = "Siparişler"
End If
siparislerWs.Cells.Clear
siparisRow = 1

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Siparişler" Then
lastRow = ws.Cells(ws.Rows.count, "F").End(xlUp).row
For i = 1 To lastRow
If LCase(Trim(ws.Cells(i, "F").Value)) = "sipariş" Then
For j = 1 To ws.UsedRange.Columns.count
siparislerWs.Cells(siparisRow, j).Value = ws.Cells(i, j).Value
Next j
siparisRow = siparisRow + 1
End If
Next i
End If
Next ws

MsgBox "Kopyalama işlemi tamamlandı.", vbInformation
End Sub

 

[catalinastrap]

Dosya hali ektedir

 

[hamitalper]

hocam merhaba emeğinize sağlık öncelikle buna sütun başlıkları eklersek eğer nasıl çalıştırabiliriz Siparişler kısmında ilgili sütun isimleride olcak

 

[catalinastrap]

Bu şekilde istediniz galiba

 

[hamitalper]

Bu şekilde istediniz galiba
Aynen Özgür abi teşekkürler