Loop web data into new column on same sheet (Code included)

How can I modify this so it outputs the data to a new column on just 1 sheet. Right now, it's creating new sheets for each link. Would like to output to column 1, 2, 3 , 4, 5, etc...

Sub ImportWebData()

J = 1
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

With Sheets("Input")

   RowCount = 1
   Do While .Range("A" & RowCount) <> ""
      CellName = .Range("A" & RowCount)
      URL = CellName

      'get web page
      IE.Navigate2 URL
      Do While IE.readyState <> 4 Or _
         IE.Busy = True
         DoEvents
      Loop

        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = J
    
            Sheets(J).Select
            Cells.Select
            Selection.Delete Shift:=xlUp
            Range("A1").Select
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & CellName, Destination:=Range("$A$2"))
                .Name = CellName
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlEntirePage
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            
            J = J + 1
            
    Sheets("Input").Select
    RowCount = RowCount + 1
    
    Loop
    
End With
IE.Quit

End Sub