insert column, add content & delete source on txt import

[jsalazar82]

I'm trying to add the name in the first line of the source txt file to each row in a new column and then delete the source row. Source text would go into column A - column title "switch". pushing all the the other columns over by one & joining the now row1 headers "Vlan MacAddress Type Ports". Any help is greatly appreciated!


--source txt--

SWITCH1NAME
Vlan MacAddress Type Ports
1 000a.f467.9e51 DYNAMIC Fa0/1
1 000a.f467.9e52 DYNAMIC Fa0/2
...


1 000a.f467.9e98 DYNAMIC Fa0/48

--macro--

Sub Import_txt_files()


Dim nxt_row As Long


Const strPath As String = "C:\VBAtest\"
Dim strExtension As String


Application.ScreenUpdating = False


ChDir strPath


strExtension = Dir(strPath & "*.txt")


Do While strExtension <> ""


    Range("A65536").End(xlUp).Offset(1, 0).Value = strExtension


    nxt_row = Range("A65536").End(xlUp).Offset(1, 0).Row


    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strPath & strExtension, Destination:=Range("$A$" & nxt_row))
        .Name = strExtension
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileOtherDelimiter = "="


        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


    strExtension = Dir
Loop


    Application.ScreenUpdating = True




End Sub

 

[jsalazar82]

hoping for this final output

 

[jsalazar82]

ended up with this:

Sub VISA_switch_reorg33FINAL()

    'to apply to all sheets
    Dim wk As Worksheet
    For Each wk In ActiveWorkbook.Worksheets
    wk.Activate


    Application.DisplayAlerts = False
    
    'space delimited to columns
    With Range(Selection.Cells, Selection.Cells.End(xlDown))
        .TextToColumns Destination:=.Cells(1, 1), _
                       DataType:=xlDelimited, _
                       Space:=True
    End With
    
    'move column
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    'title column
    Range("A2").Value = "Switch"
    
    'fill range with switchname
    Dim rng As Range
    Dim i As Long
    Set rng = Range("B3:B100")
    For Each cell In rng
        If cell.Value <> "" Then
            cell.Offset(0, -1).Value = Range("B1")
        End If
    Next
    
    'delete top row with switchname
    Rows(1).EntireRow.Delete
    Next wk
    
End Sub