Select multiple worksheets and copy to desktop folder

Fergie · Jan 15th 2019

[SIZE=11px]Using a macro enabled work book to process a number of files and have them in a desktop folder together with the result.

What I’m trying to do

1 User selects one or more.csv files and clicks “Copy”

2 Macro creates new desktop folder using

MkDir "C:\Users" & Environ("UserName") & "\Desktop\Matches" & " " & Format (Now (), "DD-MMM-YYYY hh mm ss")

(Time format so there will never be an issue with the folder already existing)

3 Macro pastes copies of selected files intact into newly created folder.

4 Macro takes Sheet2 of each from row 2** and combines them into new sheet "Matches.csv", which is then opened.
**(So headers are lost. This is because I am sure there is a way of merging them using the headers from the first sheet but I don’t know how to do this, so I have cheated and get the macro to populate the headers afterwards)[/SIZE]

[SIZE=11px]From that point on I know what I'm doing and can run the macro over the sheet and save the resulting summary alongside the sheets that have been summarised. I have pieced together the code below which works in conjunction with the rest of my macro, but of course does everything within the macro enabled workbook. I am very much a beginner at this so have no real idea how to modify this to do what I have set out above. All I seem to be able to find is based on moving files between pre-determined folder locations, where I need something dynamic.[/SIZE]

[SIZE=11px]I should also explain that these were originally written by a colleague who is no longer with us. Although I was involved in this it was only as a user, advising what was required. I had nothing to do with writing the actual code. I have had to sit down with text books and Google to try and learn what the code does and how it works. I have learned to modify the body of the macros reasonably well but the initial download and saving areas are still a bit of a mystery to me. So far I have been able to use the code he wrote previously. What I’m trying to do here is outside of that and so I am struggling. Suffice to say I am not anything like as proficient at this as some of the code might lead you to think!
Any help would be greatly appreciated.[/SIZE]

Code

Dim CurrentBook As Workbook
Dim info As String
info = "UserForm 1 Matches"


Dim lastrow As Long
Dim length As Integer
Dim MyFileName As Variant
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("Sheet2")
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer
Dim r As Range
Dim Sheet As Variant
Set IndvFiles = Application.FileDialog(msoFileDialogOpen)
With IndvFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".csv files", "*.csv"
    .Show
End With


Application.DisplayAlerts = False
Application.ScreenUpdating = False


For FileIdx = 1 To IndvFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
    For Each Sheet In CurrentBook.Sheets
        Dim LRow1 As Long
        LRow1 = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
        Dim LRow2 As Long
        LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row


        Dim ImportRange As Range
        Set ImportRange = CurrentBook.ActiveSheet.Range("A2:Z" & LRow2)
        ImportRange.Copy
        WS.Range("A" & LRow1 + 1).PasteSpecial 'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
    CurrentBook.Close False
Next FileIdx

Display More

John_w · Jan 17th 2019

See if this macro does steps 1 to 4, as required. Rather than opening each selected .csv file, it uses a text query to import the data into the macro workbook. The first .csv file import starts at row 1, to include column headings, and subsequent files start at row 2 to omit them. I put comments in the code to help you to understand it.

Code

Public Sub Copy_and_Import_Selected_CSV_Files()


    Dim destinationFolder As String
    Dim destinationCell As Range
    Dim startRow As Long
    Dim FD As FileDialog
    Dim csvFile As Variant
    
    'Set destination folder where .csv files will be copied - a new Desktop subfolder


    destinationFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Matches " & Format(Now, "DD-MMM-YYYY hh mm ss\")


    If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
    If Dir(destinationFolder, vbDirectory) = vbNullString Then MkDir destinationFolder
    
    'Set destination cell where first .csv file will be imported - A1 in first sheet in this workbook
    
    With ThisWorkbook.Worksheets(1)
        .Cells.Clear
        Set destinationCell = .Range("A1")
    End With
    startRow = 1
    
    'Select multiple .csv files
    
    Set FD = Application.FileDialog(msoFileDialogOpen)
    With FD
        .AllowMultiSelect = True
        .Title = "Multi-select target data files:"
        .ButtonName = ""
        .Filters.Clear
        .Filters.Add ".csv files", "*.csv"
        If Not .Show Then Exit Sub
    End With
  
    'For each .csv file, copy it to destination folder and import data
    
    For Each csvFile In FD.SelectedItems
      
        'Copy .csv file to destination folder
        
        FileCopy csvFile, destinationFolder & Mid(csvFile, InStrRev(csvFile, "\") + 1)
        
        'Import csv data to current destination cell
        
        With destinationCell.Worksheet.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=destinationCell)
            .TextFileStartRow = startRow
            .TextFileCommaDelimiter = True
            .Refresh BackgroundQuery:=False
            Set destinationCell = destinationCell.Offset(.ResultRange.Rows.Count, 0)
            .Delete
        End With
        
        'Import next csv data from row 2
        
        startRow = 2
        
    Next
    
    'Save destination sheet as Matches.csv in destination folder
    
    destinationCell.Worksheet.Copy
    ActiveWorkbook.SaveAs Filename:=destinationFolder & "Matches.csv", FileFormat:=xlCSV
    ActiveWorkbook.Close False
    
    'Clear destination sheet in this workbook
    
    destinationCell.Worksheet.Cells.Clear
    
    'Open Matches.csv
    
    Workbooks.Open Filename:=destinationFolder & "Matches.csv"
    
    MsgBox "Finished"
  
End Sub

Display More

Fergie · Jan 17th 2019

Wow! That is so helpful of you I will cetainly try that, and the explanations are just what I needed to try and get my head around it. Thank you so much.

Select multiple worksheets and copy to desktop folder

Participate now!

Share