Bir satırdaki datayı başka sayfaya kopyalama

[raaroka]

Merhaba arkadaşlar,
Eklemiş olduğum dosyada,
Genel sayfasının 2.Satırında bulunan "departman" DOKTOR ise doktor sayfasına , Hemşire ise Hemşire sayfasına bütün o satır kopyalansın.


Yalnız örnek sayfada satır az normalde bu yaklaşık 10000 satır için uygulanıyor olacak.
Yardımlarınızı bekliyorum,

 

[raaroka]

dosyayı şimdi ekliyorum

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
Application.ScreenUpdating = False

Sheets("Doktor").Range("A2:N65536").Clear
Sheets("Hemşire").Range("A2:N65536").Clear

For i = 2 To Sheets("Genel").[B65536].End(3).Row

If Sheets("Genel").Cells(i, "B") = "DOKTOR" Then
satir = Sheets("Doktor").[A65536].End(3).Row + 1
Sheets("Genel").Range("A" & i & ":N" & i).Copy Sheets("Doktor").Range("A" & satir)
Else
End If

If Sheets("Genel").Cells(i, "B") = "HEMŞİRE" Then
satir2 = Sheets("Hemşire").[A65536].End(3).Row + 1
Sheets("Genel").Range("A" & i & ":N" & i).Copy Sheets("Hemşire").Range("A" & satir2)
Else
End If
Next i

Application.ScreenUpdating = True
MsgBox " B i t t i "

satir = Empty
satir2 = Empty
i = Empty

End Sub

. . .

 

[raaroka]

. . .

Sub kod()
Application.ScreenUpdating = False

Sheets("Doktor").Range("A2:N65536").Clear
Sheets("Hemşire").Range("A2:N65536").Clear

For i = 2 To Sheets("Genel").[B65536].End(3).Row

If Sheets("Genel").Cells(i, "B") = "DOKTOR" Then
satir = Sheets("Doktor").[A65536].End(3).Row + 1
Sheets("Genel").Range("A" & i & ":N" & i).Copy Sheets("Doktor").Range("A" & satir)
Else
End If

If Sheets("Genel").Cells(i, "B") = "HEMŞİRE" Then
satir2 = Sheets("Hemşire").[A65536].End(3).Row + 1
Sheets("Genel").Range("A" & i & ":N" & i).Copy Sheets("Hemşire").Range("A" & satir2)
Else
End If
Next i

Application.ScreenUpdating = True
MsgBox " B i t t i "

satir = Empty
satir2 = Empty
i = Empty

End Sub

. . .

Üstadım bunu nasıl uyguluyoruz.Bu konuda bilgim yok yardımcı olursan sevinirim

 

[raaroka]

. . .

Sub kod()
Application.ScreenUpdating = False

Sheets("Doktor").Range("A2:N65536").Clear
Sheets("Hemşire").Range("A2:N65536").Clear

For i = 2 To Sheets("Genel").[B65536].End(3).Row

If Sheets("Genel").Cells(i, "B") = "DOKTOR" Then
satir = Sheets("Doktor").[A65536].End(3).Row + 1
Sheets("Genel").Range("A" & i & ":N" & i).Copy Sheets("Doktor").Range("A" & satir)
Else
End If

If Sheets("Genel").Cells(i, "B") = "HEMŞİRE" Then
satir2 = Sheets("Hemşire").[A65536].End(3).Row + 1
Sheets("Genel").Range("A" & i & ":N" & i).Copy Sheets("Hemşire").Range("A" & satir2)
Else
End If
Next i

Application.ScreenUpdating = True
MsgBox " B i t t i "

satir = Empty
satir2 = Empty
i = Empty

End Sub

. . .

Üstadım çok teşekkürler çalıştırmayı başardım.
Emeğinize sağlık

 

[raaroka]

Geliştirme

Üstadım bu taraf iin teşekkürler
Birde bu makroyu çalıştırdığımda
son işlem olarak bütün sayfalarda Bir satır beyaz (Yani normal kalacak) 2. satır sarı olacak. b u şekilde bir satır renkli bir satır renksiz son dolu satıra kadar tamamlanacak.Bunun dışında yapma şansımız warsa her hücre kare içerisine alınacak

Yardımınız için teşekkürler