Hi
I try to copy a column from each file in a folder and past it in a new workbook.
Any tip?
Files in folder:
I get this waring, i need to automatic answer No:
I try to copy a column from each file in a folder and past it in a new workbook.
Any tip?
Files in folder:
I get this waring, i need to automatic answer No:
VBA Code:
Sub LesKatalog()
Dim folderPath As String
folderPath = "d:\Gdrive\NAS\PulseFit\PulseFitReadFilesVB\" ' Change this to the path of your folder
Dim fileName As String
fileName = Dir(folderPath & "\*.xls")
Dim wbDestination As Workbook
Set wbDestination = Workbooks.Add
Dim wsDestination As Worksheet
Set wsDestination = wbDestination.Sheets.Add
Dim wbSource As Workbook
Dim fileNames() As String
Dim i As Integer
i = 0
Do While fileName <> ""
ReDim Preserve fileNames(i)
fileNames(i) = fileName
i = i + 1
fileName = Dir(folderPath & "\*.xlsx")
Loop
If i = 0 Then
MsgBox "No Excel workbooks found in the specified folder."
Exit Sub
End If
' Sort fileNames()
Dim j As Integer
For i = LBound(fileNames) To UBound(fileNames) - 1
For j = i + 1 To UBound(fileNames)
On Error Resume Next
If CDate(Left(fileNames(i), 10)) > CDate(Left(fileNames(j), 10)) Then
Dim temp As String
temp = fileNames(i)
fileNames(i) = fileNames(j)
fileNames(j) = temp
End If
On Error GoTo 0
Next j
Next i
For i = LBound(fileNames) To UBound(fileNames)
Set wbSource = Workbooks.Open(folderPath & "\" & fileNames(i))
wbSource.Sheets(1).Range("A1", wbSource.Sheets(1).Range("A1").End(xlDown)).Copy
wsDestination.Range("A" & wsDestination.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbSource.Close False
Application.CutCopyMode = False
Next i
End Sub