Convert rows to columns

It works excellent when I have one file. I didin´t mention that I have several skv-files that I would like to convert and insert into one excel sheet.

I have a code that imports all the skv-files but I want them to be transposed like your code does.

My current code looks like this:

Dim fPath   As String:      fPath = "P:\8203 Vrena Deponi\11 UNDERLAG\Loggdata från Vrena\2013\02\"    'path to SKV files, include the final \
Dim fSKV    As String
Dim wbSKV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("Mätvärden")

If MsgBox("Rensa befintliga mätvärden innan import?", vbYesNo, "Rensa?") _
    = vbYes Then wsMstr.UsedRange.Clear

Application.ScreenUpdating = False  'speed up macro

fSKV = Dir(fPath & "*.SKV")         'start the SKV file listing

    Do While Len(fSKV) > 0
      'open a SKV file
        Set wbSKV = Workbooks.Open(fPath & fSKV)
                    
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
           TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=True, Comma:=False, Space:=False, Other:=False, OtherChar:="", _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
            Array(5, 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
        
        'insert col A and add SKV name
        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
             
        'copy date into master sheet and close source file
       ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(2)
          
       wbSKV.Close False
      'ready next SKV
       fSKV = Dir
    Loop
 
Application.ScreenUpdating = True
End Sub

So I want to have a loop that imports the skv-files, convert them into columns and then add the filename i a new column.

Is that possible?

//Olov

Thank you!

I tweaked the code a little bit and made it work!

The code that worked the way I wanted to looks like this:

Sub a()
Dim fPath   As String
Dim fSKV    As String
Dim wbSKV   As Workbook
Dim wsMstr  As Worksheet
Set wsMstr = ThisWorkbook.Sheets("Mätvärden")
fPath = "P:\8203 Vrena Deponi\11 UNDERLAG\Loggdata från Vrena\2013\02\"    'path to SKV files, include the final \
If MsgBox("Rensa befintliga mätvärden innan import?", vbYesNo, "Rensa?") _
    = vbYes Then wsMstr.UsedRange.Clear

Application.ScreenUpdating = False  'speed up macro

fSKV = Dir(fPath & "*.SKV")         'start the SKV file listing
    r = 1
    Do While Len(fSKV) > 0
        Set wbSKV = Workbooks.Open(fPath & fSKV)
        s = CreateObject("scripting.filesystemobject").opentextfile(fPath & fSKV).readall
        s1 = Replace(s, vbCrLf, ";")
        sn = Split(s1, ";")
        For j = 0 To UBound(sn)
          sp = Split(sn(j), ";")
          u = UBound(sp)
          If u <= 0 Then u = 0
          Cells(r, j + 1).Resize(u + 1) = sp
        Next
      
      'insert col A and add SKV name
        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
      
      'copy date into master sheet and close source file
      ActiveSheet.Range("A1:I1").Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
      
        wbSKV.Close False
      'ready next SKV
       fSKV = Dir
       'r = r + 1
    Loop
 Application.ScreenUpdating = True


End Sub

Thank you very much for you help!

//Olov