Bir hücrede veri olması durumunda satırı başka sayfaya aktarma

[serif_007]

Merhabalar arkadaşlar.

Bir arıza tablom var Örneğin A2 ve O25 hücreleri arası verilerim var. N sütunu dolu olduğunda Commandbutton vasıtası ile kaydı aynı tablo yapısına sahip farklı bir sayfaya aktarmak istiyorum. Örnek çalışma eklemek isterdim fakat dosya kurumsal veri içeridiği için eklemeye çekiniyorum. Dikkat edilmesi gereken tek bir konu var aktarılan satır diğer sayfada dolu satırın altına gelmesi. Yani "Güncel Arızalar" Sayfasında N hücresi dolu olduğunda commandbutona basıldığında bu dolu olan hücreye ait satırı A:O arası, komple "Sonuçlanan Arızalar" sayfasında A:O arasına taşıayacak. Aynı zamanda da "Güncel Arızalar" sayfasından aktarılan sütunu silecek.

Yardımlarınız için şimdiden teşekkür ediyorum

 

[dEdE]

... Örnek çalışma eklemek isterdim fakat dosya kurumsal veri içeridiği için eklemeye çekiniyorum...

Merhaba,
Örnek dosyanızın kurumsal verileri içermesi gerekmez. Verileri AAA, BBB, 123, 456 gibi ifade edebilirsiniz. Örnek dosyanın, gerçek dosyanızın sayfa yapısını bire bir yansıtması ve hangi veriyi hangi koşulda nereye taşıyacağınızı açıklaması yeterli olacaktır.

 

[Muzaffer Ali]

Merhaba.
Deneyiniz.

Sub Test()
    Dim Bak As Long
    Dim Say As Long
    Dim syfGuncel As Worksheet
    Dim syfSonuc As Worksheet
    
    Set syfGuncel = Worksheets("Güncel Arızalar")
    Set syfSonuc = Worksheets("Sonuçlanan Arızalar")
    
    For Bak = syfGuncel.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Not syfGuncel.Cells(Bak, "N") = "" Then
            Say = syfSonuc.Cells(Rows.Count, "A").End(xlUp).Row + 1
            syfGuncel.Range("A" & Bak & ":O" & Bak).Cut syfSonuc.Cells(Say, "A")
        End If
    Next
    MsgBox "Tamamlandı."
End Sub

 

[serif_007]

Merhaba.
Deneyiniz.

Sub Test()
    Dim Bak As Long
    Dim Say As Long
    Dim syfGuncel As Worksheet
    Dim syfSonuc As Worksheet
   
    Set syfGuncel = Worksheets("Güncel Arızalar")
    Set syfSonuc = Worksheets("Sonuçlanan Arızalar")
   
    For Bak = syfGuncel.Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Not syfGuncel.Cells(Bak, "N") = "" Then
            Say = syfSonuc.Cells(Rows.Count, "A").End(xlUp).Row + 1
            syfGuncel.Range("A" & Bak & ":O" & Bak).Cut syfSonuc.Cells(Say, "A")
        End If
    Next
    MsgBox "Tamamlandı."
End Sub

çok teşekkkür ederim. bir alternatif de ben ekleyeyim.

Private Sub CommandButton7_Click()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("GÜNCEL ARIZALAR").UsedRange.Rows.Count
    J = Worksheets("SONUÇLANAN ARIZALAR").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("SONUÇLANAN ARIZALAR").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("GÜNCEL ARIZALAR").Range("P1:P" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Arıza Giderildi." Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("SONUÇLANAN ARIZALAR").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Arıza Giderildi." Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True

End Sub