How to copy column and transpose paste into new workbook with folder containing several files? - vba

Question

I have a folder containing nearly 1,000 .csv files. I would like to grab the second column from each of these files and transpose-paste them into a new Excel workbook, so that the data is in one row.
The following is what i have so far:
Sub OpenFiles2()
Dim MyFolder As String
Dim MyFile As String
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Do While myPath <> ""
Range(Range("B1"), Range("B1").End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWorkbook.Close True
Windows("Compiled.xlsm").Activate
Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1,0).PasteSpecial Transpose:=True
MyFile = Dir
Loop
End Sub
For some reason I keep getting an error for the Paste Special command.
I also tried to replace it with:
ActiveSheet.PasteSpecial Transpose:=True
And
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= False, Transpose:=True
Still got errors. Please help. Thank you.

Answer 1

I would avoid using select and deal with the values. This code stores the original value in a variable, then you can close the active workbook and use the data in that variable by using the Application.Transpose within VBA.
Replace the Do Loop with the below code.
Do While myPath <> ""
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
x = Range("B1:B" & lastrow).Value
ActiveWorkbook.Close True
With Worksheets("Sheet1")
Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1). _
Resize(, lastrow).Value = Application.Transpose(x)
End With
MyFile = Dir
Loop