Split worksheets with the same column range in workbook to Separate Excel Files With VBA Code

3886 views excel
0

My first question to stackoverflow and new to VBA. I've looked everywhere and feel like I've tried everything to find a solution to the issue above.

I want to copy the same columns of each worksheet in a workbook to a new file based on the worksheet name.

I've found the following VBA code that copies the whole sheet, but am having the hardest time making it just copy Range("A:K") on each sheet to a new file. I thought the following code might work but I am seriously way off.

Sub Splitbook()
'Updateby20140612
Dim xPath As String
Dim rng As Range
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    Set rng = Range("A:K")
    xWs.rng.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Any help is greatly appreciated. And many thanks in advance.

answered question

1 Answer

13

Untested:

Sub Splitbook()

    'Updateby20140612
    Dim xPath As String, xWs as Worksheet
    Dim rng As Range, wb as workbook

    xPath = Application.ActiveWorkbook.Path

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each xWs In ThisWorkbook.Sheets
        set wb = workbooks.add()
        xWs.Range("A:K").Copy wb.sheets(1).range("A1")
        wb.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
        wb.Close False
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

posted this

Have an answer?

JD

Please login first before posting an answer.