Değerli üstadlar, ek dosya sorunumu dile getirdim. Yardımlarınız için şimdiden teşekkürler. Saygılarımla.
aşağıdaki makroyu kullanıyorum. Yanlız diğer aşamalarda veya ekranında işlem yapan kullanıcıların kullandığı satırlar boş değil ise üstüne yazmasın. üstüne yazdığında ekrandaki sipariş kayboluyor.
Sub aktar()
Dim sonsat_kalite As Long, sat As Long, i As Long, k As Byte
Sheets("kalite").Select
sonsat_kalite = Cells(65536, "A").End(xlUp).Row
sat = Sheets("dosya").Cells(65536, "A").End(xlUp).Row + 5
For i = sonsat_kalite To 2 Step -1
If LCase(Replace(Replace(Cells(i, "j").Value, "D", "d"), "d", "d")) = "d" Then
For k = 1 To 20
Sheets("dosya").Cells(sat, k).Value = Cells(i, k).Value
Next k
sat = sat + 1
Rows(i).Delete
End If
Next i
MsgBox "İşlem Tamam.."
End Sub
aşağıdaki makroyu kullanıyorum. Yanlız diğer aşamalarda veya ekranında işlem yapan kullanıcıların kullandığı satırlar boş değil ise üstüne yazmasın. üstüne yazdığında ekrandaki sipariş kayboluyor.
Sub aktar()
Dim sonsat_kalite As Long, sat As Long, i As Long, k As Byte
Sheets("kalite").Select
sonsat_kalite = Cells(65536, "A").End(xlUp).Row
sat = Sheets("dosya").Cells(65536, "A").End(xlUp).Row + 5
For i = sonsat_kalite To 2 Step -1
If LCase(Replace(Replace(Cells(i, "j").Value, "D", "d"), "d", "d")) = "d" Then
For k = 1 To 20
Sheets("dosya").Cells(sat, k).Value = Cells(i, k).Value
Next k
sat = sat + 1
Rows(i).Delete
End If
Next i
MsgBox "İşlem Tamam.."
End Sub
Son düzenleme: