Importing Multiple Data Sets

Reebs

New Member
Joined
Aug 27, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Is there any way to combine these macros to import them to their proper sheets into one?
VBA Code:
Sub Get_Shot_Data()
    
    Application.ScreenUpdating = False
    
    Dim target_workbook As Workbook
    Dim data_sheet As Worksheet
    Dim folder_path As String, my_file As String
    Dim LastRow As Long
    
    Set data_sheet = ThisWorkbook.Worksheets("Shot Data")
    
    folder_path = "J:\Public\TI OPS TOOLS\X-Ray Tracker\Newest Exports\"
    
    my_file = Dir(folder_path & "*.csv")
    
    '// Step 1: Clear worksheet
    If my_file = vbNullString Then
        MsgBox "CSV files not found.", vbInformation
    Else:
        data_sheet.Cells.ClearContents
    End If
    
    '// Step 2: Iterate CSV Files
    Do While my_file <> vbNullString
        Set target_workbook = Workbooks.Open(folder_path & my_file)
            
        LastRow = data_sheet.Cells(Rows.Count, "A").End(xlUp).Row
        
        target_workbook.Worksheets(1).Range("A1").CurrentRegion.Copy data_sheet.Cells(LastRow + 1, "A")
        target_workbook.Close False
        
        Set target_workbook = Nothing
        
        my_file = Dir()
    Loop

    '// Step 3: Clean up
    data_sheet.Rows(1).Delete
    data_sheet.Range("A1").CurrentRegion.RemoveDuplicates 1, xlNo
    
    Set data_sheet = Nothing

Application.ScreenUpdating = True

End Sub
VBA Code:
Sub Get_View_Data()
    Application.ScreenUpdating = False
    Dim target_workbook As Workbook
    Dim data_sheet As Worksheet
    Dim folder_path As String, my_file As String
    Dim LastRow As Long
    
    Set data_sheet = ThisWorkbook.Worksheets("Views Read")
    
    folder_path = "J:\Public\TI OPS TOOLS\X-Ray Tracker\Views Read Data\"
    
    my_file = Dir(folder_path & "*.xlsx")
    
    '// Step 1: Clear worksheet
    If my_file = vbNullString Then
        MsgBox "files not found.", vbInformation
    Else:
        data_sheet.Cells.ClearContents
    End If
    
    '// Step 2: Iterate CSV Files
    Do While my_file <> vbNullString
        Set target_workbook = Workbooks.Open(folder_path & my_file)
            
        LastRow = data_sheet.Cells(Rows.Count, "A").End(xlUp).Row
        
        target_workbook.Worksheets(1).Range("A1").CurrentRegion.Copy data_sheet.Cells(LastRow + 1, "A")
        target_workbook.Close False
        
        Set target_workbook = Nothing
        
        my_file = Dir()
    Loop

Application.ScreenUpdating = True

End Sub

They are different file types which may make it difficult.
Thanks in advance!
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,147
Office Version
  1. 2013
Platform
  1. Windows
IMO this is the closest you can get. Try it on copies of your workbooks.

VBA Code:
Public Sub Reebs()

    Dim wsData      As Worksheet
    Dim DiskFolder  As String
    Dim FileSpec    As String

    Set wsData = ThisWorkbook.Worksheets("Shot Data")
    DiskFolder = "J:\Public\TI OPS TOOLS\X-Ray Tracker\Newest Exports\"
    FileSpec = "*.csv"
    GetData wsData, DiskFolder, FileSpec

    Set wsData = ThisWorkbook.Worksheets("Views Read")
    DiskFolder = "J:\Public\TI OPS TOOLS\X-Ray Tracker\Views Read Data\"
    FileSpec = "*.xlsx"
    GetData wsData, DiskFolder, FileSpec

End Sub


Public Sub GetData(ByVal argSht As Worksheet, ByVal argDataFolder As String, ByVal argFileSpec As String)

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim target_workbook As Workbook
    Dim my_file As String

    my_file = Dir(argDataFolder & argFileSpec)

    '// Step 1: Clear worksheet
    If my_file = vbNullString Then
        MsgBox "files not found.", vbInformation
    Else:
        argSht.Cells.ClearContents
    End If

    '// Step 2: Iterate CSV Files
    Do While my_file <> vbNullString
        Set target_workbook = Workbooks.Open(argDataFolder & my_file)
        With argSht
            target_workbook.Worksheets(1).Range("A1").CurrentRegion.Copy _
                            Destination:=.Range("A" & .Cells(.Rows.Count, "A").End(xlUp)).Offset(1, 0)
        End With
        target_workbook.Close False
        Set target_workbook = Nothing
        my_file = Dir()
    Loop

    '// Step 3: Clean up
    If LCase(argFileSpec) = "*.csv" Then
        argSht.Rows(1).Delete
        argSht.Range("A1").CurrentRegion.RemoveDuplicates 1, xlNo
    End If

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
 

Forum statistics

Threads
1,144,342
Messages
5,723,818
Members
422,518
Latest member
quack_quack

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top