Paste Values with UsedRange

[sauzee]

Hi All

I got this great code from following website to import into one spreadsheet.

How to quickly batch import multiple csv/text/xml files in Excel?

ExtendOffice provides a comprehensive range of professional software solutions, enhancing productivity and efficiency for businesses worldwide.

www.extendoffice.com

I'm guessing it's very simple for for the life of me I just can't figure out how to simply copy and paste the values only (I want to keep the formatting the same on the destination spreadsheet). Can anyone help - thanks!

Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.csv")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no files csv", , "Kutools for Excel"
End Sub

 

[MARK858]

Maybe...

    With ActiveSheet.UsedRange
        xSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With

 

[sauzee]

Thanks Mark - so the full code is same as below? I'm afraid that didn't work. For example, the imported csv is still font size 11 rather then font size 8 in the destination sheet. A workaround would be to format the csv file before import but setting the format in the destination sheet would be easier.

Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.csv")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
       
    With ActiveSheet.UsedRange
        xSht.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With


        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no files csv", , "Kutools for Excel"
End Sub

 

[MARK858]

I am not sure by your last description what you want. In your first post you asked

I just can't figure out how to simply copy and paste the values only

Which is what the code I posted does (Well actually it inserts the values without copying and pasting). Are you asking for the formats from the Destination sheet to be copied to the source sheet?

 

[sauzee]

Ah sorry - can understand the confusion. What I originally wrote wasn't completely clear. What I meant was copy and paste values (i.e. PasteSpecial Paste:=xlPasteValues) to preserve the formatting in the destination spreadsheet rather than just copy and paste

Thanks

 

[MARK858]

The lines that I posted do exactly the same as Copy PasteSpecial Paste:=xlPasteValues, just more efficiently.