Snasui Excel Forum

Code: Select all

Option Explicit
Sub TransferData()
Dim r As Range
Dim i As Integer
Dim k As Integer
Dim rt As Range
k = Worksheets("Issue Log").Range("L65536").End(xlUp).Row
With Worksheets("Issue Log")
    For i = k To 2 Step -1
        If .Cells(i, "L") = "Cancelled" Or .Cells(i, "L") = "Closed" Then
            Set r = .Range("L" & i).Offset(0, -11).Resize(1, 17)
            Set rt = Worksheets("Inactive").Range("L65536").End(xlUp).Offset(1, -11).Resize(1, 17)
            r.Copy rt
            rt.Interior.ColorIndex = 15
            r.EntireRow.Delete
        End If
    Next i
End With
End Sub

Code: Select all

Option Explicit
Sub TransferData()
Dim r As Range, rt As Range
Dim rCount As Range
Dim i As Integer, k As Integer
With Worksheets("Issue Log")
k = .Range("L65536").End(xlUp).Row
    For i = k To 2 Step -1
        If .Cells(i, "L") = "Cancelled" Or .Cells(i, "L") = "Closed" Then
            Set r = .Range("L" & i).Offset(0, -11).Resize(1, 17)
            Set rt = Worksheets("Inactive").Range("L65536").End(xlUp).Offset(1, -11).Resize(1, 17)
            r.Copy rt
            rt.Interior.ColorIndex = 15
            r.EntireRow.Delete
        End If
    Next i
    .Range("C65536").End(xlUp).Offset(1, 0).EntireRow.ClearContents
    Set rCount = .Range("B65536").End(xlUp).Offset(1, 0)
    rCount = rCount.Row - 2 & " Records"
    rCount.Font.ColorIndex = 3
End With
End Sub

Code: Select all

r.Copy rt

Code: Select all

r.Copy
rt.PasteSpecial xlPasteValues

Code: Select all

Option Explicit
Sub IssueLogToReport1()
Dim r As Range, rt As Range
Dim i As Integer, k As Integer
k = Worksheets("Issue Log").Range("L65536").End(xlUp).Row
With Worksheets("Issue Log")
    For i = k To 2 Step -1
        If .Cells(i, "P") >= Date + 30 Then
            Set r = .Range("P" & i)
            Set rt = Worksheets("Report1").Range("G65536") _
                .End(xlUp).Offset(1, -6)
            r.Offset(0, -15).Resize(1, 3).Copy
            rt.PasteSpecial xlPasteValues
            r.Offset(0, -11).Copy
            rt.Offset(0, 3).PasteSpecial xlPasteValues
            r.Offset(0, -3).Copy
            rt.Offset(0, 4).PasteSpecial xlPasteValues
            r.Offset(0, -7).Copy
            rt.Offset(0, 5).PasteSpecial xlPasteValues
            r.Copy
            rt.Offset(0, 6).PasteSpecial xlPasteValues
            r.EntireRow.Delete
        End If
    Next i
End With
Application.CutCopyMode = False
End Sub

Sub MoveToNTF()
Dim rs As Range
Dim rt As Range
Set rs = Worksheets("Report1").Range("A2")
Set rt = Worksheets("NTF RP").Range("G6")
    rt = rs.Offset(0, 1) ' ss
    rt.Offset(0, 1) = rs.Offset(0, 2) 'rec
    rt.Offset(1, 0) = rs.Offset(0, 3) 'session
    rt.Offset(2, 0) = rs.Offset(0, 4) 'response
    rt.Offset(3, 0) = rs.Offset(0, 5) 'sol
    rt.Offset(4, 0) = rs.Offset(0, 6) 'target date
    Range("H:H").Replace What:="=", Replacement:="#"
    rs.Resize(1, 7).Delete shift:=xlUp
    Range("H:H").Replace What:="#", Replacement:="="
End Sub