VBA Help on Splitting Worksheet-CodePudding

I have a spreadsheet that I need to split out. For example I have columns A, B, C and D and I need to split the sheet out so:

1st Sheet - columns A & B 2nd Sheet - columns A & C 3rd sheet - columns A & D

This is for approximately 350 columns and column A needs to be the constant.

I have the below code:

Sub t()
Dim lc As Long, sh As Worksheet, newSh, ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets("Sheet2")
Set sh = ActiveSheet
With sh
    lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
    For i = 1 To lc
        If Application.CountA(.Columns(i)) > 0 Then
        
            Set newSh = Sheets.Add
            ws1.Range("a:a").Copy Range("a:a")
            Intersect(.UsedRange, .Columns(i)).Copy newSh.Range("A1")
            newSh.Copy
        
            ActiveWorkbook.SaveAs newSh.Range("a1").Value & ".xlsx"
            ActiveWorkbook.Close
            Application.DisplayAlerts = False
            newSh.Delete
            Application.DisplayAlerts = True
        End If
    Next
End With
End Sub

But this only splits out the individual columns, I need to add column A each time

CodePudding user response：

In this bit of code:

ws1.Range("a:a").Copy Range("a:a")
Intersect(.UsedRange, .Columns(i)).Copy newSh.Range("A1")

You output to column A both times. So column A is copied each time, but overwritten by whichever other column you copy. Fix this by outputting to "B1" on the second line.