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

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
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
 
Upvote 0
Hi thank you for the code which has been very helpful!

target_workbook.Worksheets(1).Range("A1").CurrentRegion.Copy data_sheet.Cells(LastRow + 4, "A")
target_workbook.Close False

Set target_workbook = Nothing

my_file = Dir()

Loop

'// Step 3: Clean up
data_sheet.Rows(1).Delete
data_sheet.Rows(1).Delete
data_sheet.Rows(1).Delete

1. I am aware that there's copy in the code, but where is the paste? (i'm trying to figure out how you manage to paste the range of cell in the worksheet to another workbook)
2. and after i use Cells(LastRow + 4, "A"), how come my copied cell did not start from A1 row but instead from B1 row?
 
Upvote 0
Been off for a while. When a destination is provided a "paste" is superfluous, so have you tried the code provided in my post #2 at all?
 
Upvote 0

Forum statistics

Threads
1,223,249
Messages
6,171,031
Members
452,374
Latest member
keccles

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
Back
Top