anastasia1428
New Member
- Joined
- Apr 26, 2021
- Messages
- 6
- Office Version
- 365
- Platform
- Windows
My bad. I forgot that you need column B. Let me modify a bitHi Zot
I was able to fix the error but when I tired to run the macro it copied Column A of each csv files instead.. See Columns C-G below..... It was supposed to copy the Column B of each files
View attachment 37733
Sub GetLastRow()
Dim SelectFolder As Integer
Dim x As Long
Dim strPath As String
Dim wsSummary As Worksheet
Dim wb As Workbook
Dim FSOLibrary As FileSystemObject
Dim FSOFolder As Object
Dim sFileName As Object
Set wsSummary = Sheet1
SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not SelectFolder = 0 Then
strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
End
End If
Application.ScreenUpdating = False
'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(strPath)
x = 1
'Loop through each file in a folder
For Each sFileName In FSOFolder.Files
Set wb = Workbooks.Open(sFileName)
If x = 1 Then
wb.Sheets("Sheet1").Range("A1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x)
x = x + 1
Else
wb.Sheets("Sheet1").Range("B1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x)
End If
x = x + 1
wb.Close True
Next
Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Application.ScreenUpdating = True
End Sub
Yesss it worked!! Thank you so muchI did not try but I think this should work
VBA Code:Sub GetLastRow() Dim SelectFolder As Integer Dim x As Long Dim strPath As String Dim wsSummary As Worksheet Dim wb As Workbook Dim FSOLibrary As FileSystemObject Dim FSOFolder As Object Dim sFileName As Object Set wsSummary = Sheet1 SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show If Not SelectFolder = 0 Then strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) Else End End If Application.ScreenUpdating = False 'Set all the references to the FSO Library Set FSOLibrary = CreateObject("Scripting.FileSystemObject") Set FSOFolder = FSOLibrary.GetFolder(strPath) x = 1 'Loop through each file in a folder For Each sFileName In FSOFolder.Files Set wb = Workbooks.Open(sFileName) If x = 1 Then wb.Sheets("Sheet1").Range("A1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x) x = x + 1 Else wb.Sheets("Sheet1").Range("B1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x) End If x = x + 1 wb.Close True Next Set FSOLibrary = Nothing Set FSOFolder = Nothing Application.ScreenUpdating = True End Sub
Glad to be able to help. Nothing to do in office now ?Yesss it worked!! Thank you so much