Search code examples
excelvbacopy-paste

Copy data and paste as values


My code currently copies rows of data from source workbooks to a Mastercopy excel. However, I would like to paste the values as number. Any idea on how I can go about modifying in the code below?

Sub copyDataFromMultipleWorkbooksIntoMaster()

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "D:\Users\AlexPeteson\Desktop\Test File\Downloads\"

Filepath = FolderPath & "*.csv"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Dim erow

Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)

'Find the last non-blank cell in column A(1)
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'Find the last non-blank cell in row 1
lastcolumn = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column

Range(Cells(3, 1), Cells(lastrow, lastcolumn)).copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 2), Cells(erow, 10))

Filename = Dir

Loop

End Sub

Solution

  • There you go, edite the master sheet name on Set ws = ...

    Option Explicit
    Sub copyDataFromMultipleWorkbooksIntoMaster()
    
        Dim FolderPath As String, Filepath As String, Filename As String
        Dim wb As Workbook, ws As Worksheet, wbTemp As Workbook, wsTemp As Worksheet
    
        'Define your master workbook and sheet
        Set wb = ThisWorkbook
        Set ws = wb.Sheets("YourMasterSheetName")
    
        FolderPath = "D:\Users\AlexPeteson\Desktop\Test File\Downloads\"
    
        Filepath = FolderPath & "*.csv"
    
        Filename = Dir(Filepath)
    
        Dim lastrow As Long, lastcolumn As Long
    
        Dim erow As Long
    
        Do While Filename <> ""
            Set wbTemp = Workbooks.Open(FolderPath & Filename, UpdateLinks:=False, ReadOnly:=True)
            Set wsTemp = wbTemp.Sheets(1) ' lets suppose it is always on the first sheet in the workbook
    
            With wsTemp
                'Find the last non-blank cell in column A(1)
                lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
                'Find the last non-blank cell in row 1
                lastcolumn = .Cells(3, Columns.Count).End(xlToLeft).Column
                .Range(Cells(3, 1), Cells(lastrow, lastcolumn)).Copy
            End With
            'Find the last blank cell on your master sheet
            erow = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1
            ws.Cells(erow, 2).PasteSpecial xlPasteValues
            wbTemp.Close Savechanges:=False
            Set wbTemp = Nothing
            Set wsTemp = Nothing
            Filename = Dir
        Loop
    
    End Sub