remove columns from multiple Excel-files in a folder

[gjvv]

Hello all,

I have multiple .xls files in a folder, and from each file/workbook I need to delete some columns (B to D, column L , column S to V).
Then I would save the files into the same folder, to .xlsx, if possible. IF not possible, I would save them automatically in to a subfolder "converted".
In steps:

1. Select the folder with the files (.xls)
2. Open the first file
3. Remove the columns
4. Save as .xlsx (same file name), (or save in different folder "converted" within the original folder)
5. Close the file
6. Open next file (then step 3,4,5 again)

I tried many codes from other topics here, but every single one of them did something I just didn't want.

Please, some help here.

 

[smozgur]

The following code should give an idea.
The code assumes the worksheet that columns will be removed is the first worksheet in the workbooks.
I recommend saving the files in the subfolder, and the code does that. However, you can set strConv = ""

Sub doIt()
Dim strPath As String
Dim strConv As String
Dim strFile As String
Dim wrk As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False 'To silence the Overwrite File message - if the files are being overwritten
    ' The xls file folder path
    strPath = "C:\SomeFolder\"
    ' Set the following variable as an emptry string to overwrite the existing file
    strConv = "converted\"
    strFile = Dir(strPath & "*.xls")
    On Error GoTo ErrHandler
    Do While Len(strFile) > 0
        DoEvents
        Set wrk = Application.Workbooks.Open(strPath & strFile)
        With wrk
            .Worksheets(1).Range("B:D,L:L,S:V").Delete
            .SaveAs strPath & strConv & Left(strFile, Len(strFile) - 4), xlWorkbookDefault
            .Close
        End With
        strFile = Dir
    Loop
ErrHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    If Err.Number Then
        MsgBox Err.Description, vbOKOnly + vbCritical
    End If
End Sub

 

[gjvv]

The following code should give an idea.
The code assumes the worksheet that columns will be removed is the first worksheet in the workbooks.
I recommend saving the files in the subfolder, and the code does that. However, you can set strConv = ""

Sub doIt()
Dim strPath As String
Dim strConv As String
Dim strFile As String
Dim wrk As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False 'To silence the Overwrite File message - if the files are being overwritten
    ' The xls file folder path
    strPath = "C:\SomeFolder\"
    ' Set the following variable as an emptry string to overwrite the existing file
    strConv = "converted\"
    strFile = Dir(strPath & "*.xls")
    On Error GoTo ErrHandler
    Do While Len(strFile) > 0
        DoEvents
        Set wrk = Application.Workbooks.Open(strPath & strFile)
        With wrk
            .Worksheets(1).Range("B:D,L:L,S:V").Delete
            .SaveAs strPath & strConv & Left(strFile, Len(strFile) - 4), xlWorkbookDefault
            .Close
        End With
        strFile = Dir
    Loop
ErrHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    If Err.Number Then
        MsgBox Err.Description, vbOKOnly + vbCritical
    End If
End Sub

Thnx! I will try this!

 

[gjvv]

The following code should give an idea.
The code assumes the worksheet that columns will be removed is the first worksheet in the workbooks.
I recommend saving the files in the subfolder, and the code does that. However, you can set strConv = ""

Sub doIt()
Dim strPath As String
Dim strConv As String
Dim strFile As String
Dim wrk As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False 'To silence the Overwrite File message - if the files are being overwritten
    ' The xls file folder path
    strPath = "C:\SomeFolder\"
    ' Set the following variable as an emptry string to overwrite the existing file
    strConv = "converted\"
    strFile = Dir(strPath & "*.xls")
    On Error GoTo ErrHandler
    Do While Len(strFile) > 0
        DoEvents
        Set wrk = Application.Workbooks.Open(strPath & strFile)
        With wrk
            .Worksheets(1).Range("B:D,L:L,S:V").Delete
            .SaveAs strPath & strConv & Left(strFile, Len(strFile) - 4), xlWorkbookDefault
            .Close
        End With
        strFile = Dir
    Loop
ErrHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    If Err.Number Then
        MsgBox Err.Description, vbOKOnly + vbCritical
    End If
End Sub

I got an error "Method SaveAs of object_Workbook failed"

 

[smozgur]

I got an error "Method SaveAs of object_Workbook failed"

Make sure you have the folder "converted" if you are using the sub folder.

To debug: Add the line below:

        With wrk
            .Worksheets(1).Range("B:D,L:L,S:V").Delete
            Debug.print strPath & strConv & Left(strFile, Len(strFile) - 4) '<--- Add this line
            .SaveAs strPath & strConv & Left(strFile, Len(strFile) - 4), xlWorkbookDefault
            .Close
        End With

Run the code and look at the path printed in the immediate window (Ctrl + G). It is the path that the updated workbook is supposed to be saved in. There must be something wrong with the file path/name.

I have the following folder structure and it works as expected:

 

[gjvv]

Make sure you have the folder "converted" if you are using the sub folder.

To debug: Add the line below:

        With wrk
            .Worksheets(1).Range("B:D,L:L,S:V").Delete
            Debug.print strPath & strConv & Left(strFile, Len(strFile) - 4) '<--- Add this line
            .SaveAs strPath & strConv & Left(strFile, Len(strFile) - 4), xlWorkbookDefault
            .Close
        End With

Run the code and look at the path printed in the immediate window (Ctrl + G). It is the path that the updated workbook is supposed to be saved in. There must be something wrong with the file path/name.

I have the following folder structure and it works as expected:

View attachment 118416

ha, ok! Thanx!