Required your help to modify the below macro.

[mohan08]

Modification required

1. To retain certain columns base on dynamic list (on sheet 2 with table name kumar), Tried to have the same on macro but will be changing from month to month. Would be great if required user to manually select row not sure if every time it will be on same row every time.
   
   
2. To delete rows from 1 to 8 Except for ABC which should be the first line in new workbook
   
   
3. Should delete Rows with NA on base on user selection (tried with macro Delval but only after running macro for 3 or 4 times it deletes the all the rows with input name. and clear all rows after the table from row 13 onwards.
   
   x =inputbox("enter the name")
   
   For Each i In Range("C:C")
   
   If i.value = x Then i.EntireRow.Delete
   
   
4. Should delete all the images in the sheet(Available in Column AI. Usually contains multiple images in the workbook.
   
   
5. To import another sheet from different work book on the new sheet created.
   

 

[mohan08]

Hi All,

Required your help on the above.

Mohan

 

[AscotMD]

1 - No list attached
2 - What is ABC
3 - Delete from the bottom
4 - ActiveSheet.DrawingObjects.Delete
5 - Not at all clear

Sub copy()
     'Create a new Excel workbook
    Dim NewCaseFile As Workbook
    Dim strFileName As String
    Dim WB As Workbook
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set WB = ThisWorkbook
    savename = WB.Path & "\" & InputBox("enter the file name to be saved") & ".xlsm"
    WB.Sheets(1).copy
    ActiveSheet.DrawingObjects.Delete
    Call DeleteCol
   
    ActiveWorkbook.SaveAs Filename:=savename, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub


Sub DeleteCol()
    Set r = ActiveSheet.UsedRange.Resize(1)
    LC = r(r.Count).Column
    For x = LC To 1 Step -1
        If Cells(9, x).Value <> "Name" And Cells(9, x).Value <> "TYPE" And Cells(9, x).Value <> "Item Code" Then
            Columns(x).EntireColumn.Delete
        End If
    Next x

    'Rows("1:3", "5;8").Delete
End Sub
'If it's not Row 1 then change the 1 in this line to match;
'Code:
'If Cells(9, x).Value

Sub DelVal()
    Dim i As Long
    Dim x As String
    x = InputBox("enter the name")
    For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
        If Cells(i, 3).Value = x Then Rows(i).Delete
    Next i
End Sub