Copy cell range from CSV and paste on the bottom of a specific sheet

Tyler19 0
Viewed 41

I'm taking monthly exported CSVs of customer information and importing them to an existing master worksheet. The front desk staff manually copies and pastes the data into the sheet, causing tons of issues in the accuracy of the data.

I was put on the task of "simplifying it" so... I decided to make a macro that the front desk can click "update" it will pull up an explorer window, they can select a download CSV for the month, and it will simply copy the range (I have this range within the macro) in that CSV sheet and add it to the bottom of the master worksheet, adding on for the totals of that year.

Issue: the CSV I import overwrites the whole sheet that is being targeted for the paste. Any idea how to stop that?

Sub UpdateServicesData()
Dim FileToOpen As Variant
Dim OpenBook As Workbook

FileToOpen = Application.GetOpenFilename("CSV or Text Files: ,*.csv;*.txt*", , "Browse for your File to Import")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
If OpenBook.Worksheets(1).Range("A2").Value >= ThisWorkbook.Worksheets("Home").Range("C3").Value Then
OpenBook.Sheets(1).Range("A2:L10000").Copy

Workbooks("TEB.xlsm").Activate
Sheets("Services Data").Select
lrTarget = Cells.Find("*", Cells(3, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
Cells(lrTarget + 1, 1).Select
ActiveSheet.PasteSpecial
Columns("A:L").AutoFit
Cells(1, 1).Select
OpenBook.Close False

End If
End If
End Sub
csv vba excel
1 Answers

This line in your code starts look after row 3 column 1 and looks for the previous cell that contains data - as you're pasting on row 2 it finds that and overwrites your data. Pretty sure that's the reason.

lrTarget = Cells.Find("*", Cells(3, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row

An almost obligatory link to how to avoid Active & Select: how-to-avoid-using-select-in-excel-vba.

Try this code. I've split the find last cell and select workbook out to separate functions - easier to reuse in other projects then.
It assumes the "Services Data" worksheet is in the same file as the VBA code.

Public Sub UpdateServiceData()

    Dim FileToOpen As String
    FileToOpen = GetFileName
    
    If FileToOpen <> "" Then
        Dim OpenBook As Workbook
        Set OpenBook = Workbooks.Open(FileToOpen)
        
        'Find last cell in CSV file.
        Dim Source_LastCell As Range
        Set Source_LastCell = LastCell(OpenBook.Worksheets(1))
        
        'Find last cell in reporting workbook.
        'ThisWorkbook means the file that the code is in.
        Dim Target_LastCell As Range
        Set Target_LastCell = LastCell(ThisWorkbook.Worksheets("Services Data")).Offset(1)
        
        'Copy and paste - it's a CSV so won't contain formula, etc.
        With OpenBook.Worksheets(1)
            .Range(.Cells(2, 1), Source_LastCell).Copy _
                Destination:=ThisWorkbook.Worksheets("Services Data").Cells(Target_LastCell.Row, 1)
        End With
        
        OpenBook.Close SaveChanges:=False
        
    End If

End Sub

Public Function GetFileName() As String

    Dim FD As FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    
    With FD
        .InitialFileName = ThisWorkbook.Path & Application.PathSeparator
        .AllowMultiSelect = False
        If .Show = -1 Then
            GetFileName = .SelectedItems(1)
        End If
    End With
    
    Set FD = Nothing

End Function

Public Function LastCell(wrkSht As Worksheet) As Range
    
    Dim lLastCol As Long, lLastRow As Long
    
    On Error Resume Next
    
    With wrkSht
        lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    End With
    
    If lLastCol = 0 Then lLastCol = 1
    If lLastRow = 0 Then lLastRow = 1
    
    Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
    
    On Error GoTo 0

End Function
Darren Bartrup-Cook0
Related