Okay, if I understood you correctly, the following code should work. I made three separate modules to place this code into (it helps me to keep them separated by functionality)...
In a module named
modFunctions:
Code:
Option Explicit
Public Sub TOGGLEEVENTS(blnState As Boolean)
'Originally written by Zack Barresse
With Application
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
End With
End Sub
Public Function ISWBOPEN(wbName As String) As Boolean
'Originally found written by Jake Marx
On Error Resume Next
ISWBOPEN = Len(Workbooks(wbName).Name)
End Function
In a module named
modFolder:
Code:
Option Explicit
'####################################################################
'####################################################################
' Routine used from VBA Express, Knowledge Base entry by Ken Puls:
' http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
'####################################################################
'####################################################################
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
In a module named
modData:
Code:
Option Explicit
'Set a public constant variable
Public Const DNL As String = vbNewLine & vbNewLine
Sub ImportData()
'Declare all variables
Dim wb As Workbook, ws As Worksheet
Dim wbX As Workbook, wsX As Worksheet
Dim i As Long, iRow As Long, iFileNum As Long, sMsg As String
Dim vFolder As Variant, sSubFolder As String, sFileName As String
Dim bOpen As Boolean
'Turn off some application-level events to improve code efficiency
Call TOGGLEEVENTS(False)
'Have the user choose the folder
vFolder = BrowseForFolder()
'Exit if nothing was chosen, variable will be False
If vFolder = False Then Exit Sub
'Check if this is what the user wants to do, confirm with a message box, exit if no
sMsg = "Are you sure you want to import data from this folder:"
sMsg = sMsg & DNL & vFolder
If MsgBox(sMsg, vbYesNo + vbDefaultButton2, "ARE YOU SURE?") <> vbYes Then Exit Sub
'Set sub-folder as variable for save name at end of routine
sSubFolder = Right(vFolder, Len(vFolder) - InStrRev(vFolder, Application.PathSeparator))
'Set destination file with one worksheet
Set wb = Workbooks.Add(xlWBATWorksheet)
Set ws = wb.Sheets(1)
'This will be the row to start data on, to incriment in loop
iRow = 2
'Loop through files in folder
sFileName = Dir$(vFolder & "\")
Do Until sFileName = ""
'Check that the file pattern matches what you want, i.e. 12.16.00.xls
If sFileName Like "??.??.??.xls" Then '### set file extension here
'Check to see if the file is open
'If file is open, set as variable, if not, open and set as variable
If ISWBOPEN(sFileName) = True Then
Set wbX = Workbooks(sFileName)
bOpen = True
Else
Set wbX = Workbooks.Open(vFolder & "\" & sFileName)
bOpen = False
End If
'Set first sheet in target workbok as worksheet variable, from which to mine data
Set wsX = wbX.Sheets(1)
'Get last row from column A (range for copy/pasting)
i = wsX.Cells(wsX.Rows.Count, 1).End(xlUp).Row
'Check if a file has been added, if not add headers (frequency)
If iFileNum = 0 Then
ws.Range("B1", ws.Cells(1, i + 1)).Value = Application.Transpose(wsX.Range("A1:A" & i))
End If
'Add data
ws.Range("B" & iRow, ws.Cells(iRow, i + 1)).Value = Application.Transpose(wsX.Range("B1:B" & i))
'Add file name to column A
ws.Range("A" & iRow).Value = "'" & Left$(sFileName, Len(sFileName) - 4)
'Incriment variable values
iRow = iRow + 1
iFileNum = iFileNum + 1
'If file was closed to start with, clean up and close it
If bOpen = False Then wbX.Close SaveChanges:=False
End If
'Get next file name
sFileName = Dir$()
Loop
'Check if file name to save exists
If Dir$(vFolder & "\" & sSubFolder & ".xls", vbNormal) = "" Then
wb.SaveAs vFolder & "\" & sSubFolder & ".xls"
MsgBox "Complete!", vbOKOnly
Else
MsgBox "File already exists! File is NOT saved!", vbInformation, "COMPLETE!"
End If
'Reset events back to application defaults
Call TOGGLEEVENTS(True)
End Sub
It works for me in testing. The file is saved to the folder the user chooses to run (wasn't sure if that's what you were looking for). Also, you said CSV files in your original post, but you posted XLS files, so the routine is looking for XLS files and not CSV files. If you need to change what files to look for, there's a place in the code that shows what the naming convention should look like and it would need to be changed to reflect as such.
Let us know if this is what you're looking for. Be sure to make a backup copy of your work and save everything before you run this. It doesn't affect any new files, only creates a new file. And no formatting is done to the file either.
HTH
Login 
Search 
Importing multiple csv files and transposing data 
further info / confirmation 
More complications - sorry! 
Facebook
Twitter
TechGuy.tv
TSG Mobile