VBA to extract action and put it in another sheet when they are closed

[Paulart69]

Hello,

I need your help or someone from the community. I am trying since 4 hours to make it work in my case. Do you have an idea of what is wrong ?

[/COLOR]Sub TransferData()

Application.ScreenUpdating = False


        Dim i As Integer
        Dim lr As Long


lr = Range("A" & Rows.Count).End(xlUp).Row


Feuil7.ListObjects("Table2").Unlist


        For i = lr To 4 Step -1
        If Cells(K, 11).Value = "Closed" Then
        Range(Cells(K, 1), Cells(i, 12)).Copy
        Sheet7.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        Range(Cells(K, 1), Cells(K, 12)).Delete
    End If
Next


Sheet7.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheet7.Select
Sheet7.ListObjects.Add(xlSrcRange, Range("A3:L" & lr), , xlYes).Name = "Table2"
End Sub


[COLOR=#333333]

Please find my file in my drive https://drive.google.com/file/d/0B5YQXffHf4okZl9rSExGaFFvQmk3RGh4SUhkT19XRTBSTUNR/view?usp=sharing
Thank you so much

 

[mrshl9898]

I can't see Table2 in the book supplied. Also, is Feuil7 Sheet7? And what sheet is lr = Range("A" & Rows.Count).End(xlUp).Row referring to?

 

[Paulart69]

Normally Table2 is the table action closed. I tried to adapt the VBA of someone so I don't know for the lr = Range("A" & Rows.Count).End(xlUp).Row and Feuil7 is Sheet7 as my licence is french it should work =)

 

[mrshl9898]

Ok, how is this working for you?

Not sure on how Table 2 fits into things. I did notice K had no value though, so I changed this to i.

Sub TransferData()

Application.ScreenUpdating = False


        Dim i As Integer
        Dim lr As Long


lr = Range("A" & Rows.Count).End(xlUp).Row


'Feuil6.ListObjects("Table1").Unlist


        For i = lr To 4 Step -1
        If Cells(i, 11).Value = "Closed" Then
        Range(Cells(i, 1), Cells(i, 12)).Copy
        Feuil7.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Range(Cells(i, 1), Cells(i, 12)).Delete
    End If
Next


Sheet7.Columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheet7.Select
Sheet7.ListObjects.Add(xlSrcRange, Range("A3:L" & lr), , xlYes).Name = "Table2"
End Sub

 

[mrshl9898]

Saw another error, so updated the above code,seems to be working for me.