Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 224
  • Last Modified:

I need help combining different excel sheets with similar file name into one spreadsheet

I have about 20 different folders all under another folder "email_lists". The folder's name is the first and last name of a person. (Example folder name: Ben Curtis)

Within each folder is about 10 - 11 .csv files with file names such as: Ben Curtis 001.csv and Ben Curtis 002.csv and Ben Curtis 003.csv and so on, all the way to 010 or 011.csv.

What I need is a function that will go through each folder and copy all the email address (only the email address) from each .csv file and paste it into one big .csv spreadsheet, then save that big spreadsheet as: "All Ben Curtis.csv."

Each Ben Curtis 001.csv type of spreadsheet has about 1,000 rows containing first name (Col A), last name (Col B) and email address (Col C).

I only need the email address.
0
mabehr
Asked:
mabehr
  • 2
  • 2
1 Solution
 
Glenn RayExcel VBA DeveloperCommented:
This code will prompt a user to browse and select a valid CSV file from a directory (any file can be chosen ).  The program will then open each CSV file (except an already consolidated file, if it exists), copy the emails from column C and insert them into column A of a template sheet.  When done, the template sheet will be saved as a CSV file - in the same folder - using the "All firstname lastname.csv" rule specified.
Option Explicit
Sub Combine_CSV_Emails()
    Dim strMaster, strFile, strFileName, strFilePath As String
    Dim strNewFileName As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    strMaster = Application.ActiveWorkbook.Name
    Range("A1").Select
    
    strFileName = Application.GetOpenFilename("CSV Files (*.csv*), *.csv")
    If strFileName = "" Or strFileName = "False" Then Exit Sub
    strFilePath = Left(strFileName, InStrRev(strFileName, "\"))
    strNewFileName = Mid(strFileName, InStrRev(strFileName, "\") + 1, 100)
    strNewFileName = "All " & Left(strNewFileName, InStrRev(strNewFileName, " ") - 1) & ".csv"
    
    strFile = Dir(strFilePath & "\*.csv*")
    Do While strFile <> ""
        If Left(strFile, 3) <> "All" Then
            Workbooks.Open Filename:=strFilePath & "\" & strFile
            'get data from column c and copy into master workbook
            Range("C1", Range("C1").End(xlDown)).Copy
            Workbooks(strMaster).Activate
            Sheets("Main").Select
            ActiveCell.PasteSpecial
            ActiveCell.End(xlDown).Offset(1, 0).Select
            Workbooks(strFile).Close SaveChanges:=False
        End If
        strFile = Dir
    Loop
    
    'save master workbook/sheet as another CSV file and close
    Sheets("Main").Select
    Sheets("Main").Copy
    ActiveWorkbook.SaveAs Filename:= _
        strFilePath & strNewFileName, FileFormat:=xlCSV, CreateBackup:=False
    ActiveWindow.Close SaveChanges:=False
    Range("A1").Select
    Range("A1", Range("A1").End(xlDown)).ClearContents
    Range("A1").Select
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Sheets("Main").Select
    MsgBox "Process complete.  " & strNewFileName & _
           " saved in same directory as source files.", vbOKOnly, "Import CSV Data"
End Sub

Open in new window


A macro-enabled workbook with this functionality is attached.

Regards,
-Glenn
EE-Import-CSV-Email.xlsm
0
 
mabehrAuthor Commented:
That worked perfectly, Glenn Ray and saved me TONS of time.
I really appreciate your help.

Thank you!!
0
 
Glenn RayExcel VBA DeveloperCommented:
You're welcome.  Don't go spamming anybody!    ;-)

Have a good weekend,
-Glenn
0
 
mabehrAuthor Commented:
Hmmm... you now have me puzzled.

"spamming anybody"??
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now