从CSV复制大数据到Excel

Question

Public Function Import_CSV (SheetName) As String

    Dim ws As Worksheet, strFile As String
    Set ws = ActiveWorkbook.Sheets(SheetName) 'set to current worksheet name
    strFile = Application.GetOpenFilename("CSV Files (*.csv),*.csv", , "Please selec .csv file...")

    Dim wbkS As Workbook
    Dim wshS As Worksheet
    Dim wshT As Worksheet
    Set wbkS = Workbooks.Open(Filename:=strFile)
    Set wshS = wbkS.Worksheets(1)
    LastRow = wshS.UsedRange.Rows.Count
    LastCol = wshS.UsedRange.Columns.Count

    With ws
        For i = 1 To LastRow Step 1
            For j = 1 To LastCol Step 1
                .Cells(i, j).Value = wshS.Cells(i, j)
            Next
        Next
    End With
    wbkS.Close

    ActiveWorkbook.Save

End Function

i tried the above code to copy the data from .csv file to excel sheet. but my csv file is big (2000 rows and 2000 columns). its taking lot of time. is there any other way i can copy the data to excel without much time.

Please help me on this issue.

Answer 1

If the need is copying the values from one worksheet to another but saving the formats of the destination worksheet, then you can either assign the whole values array from the source range to the destination range.

Example:

Sub test()

 Set ws = Worksheets(2)
 Set wshS = Worksheets(1)

 LastRow = 2000
 LastCol = 2000

 ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, LastCol)).Value = wshS.Range(wshS.Cells(1, 1), wshS.Cells(LastRow, LastCol)).Value

End Sub

With this you may run into memory issues with very big arrays.

Or you could use the clipboard and then paste special only the values.

Example:

Sub test2()

 Set ws = Worksheets(2)
 Set wshS = Worksheets(1)

 LastRow = 2000
 LastCol = 2000

 wshS.Range(wshS.Cells(1, 1), wshS.Cells(LastRow, LastCol)).Copy
 ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, LastCol)).PasteSpecial Paste:=xlPasteValues

 Application.CutCopyMode = False

End Sub

This is even faster for me but this could be a subjective impression.