VBA - Object 400 - After Selected File to do a Copy and Paste Vlookup

uvela

New Member
Joined
Feb 18, 2022
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Hello,

I'm trying to Select a File with a static table with Allocation Data and then copy and paste the data in each workbook corresponding to the employee number after a vlookup of cell A2.

The first block of If statements is a file selector which returns the file path. I believe I'm referencing the file path and then activating the workbook after that but am not sure.

After that I am trying to loop through each workbook in the stated directory with a vlookup of the value in range A2 in each workbook and paste the value in the Selected File at the bottom of column A in the looped through workbook.

Below is the code that is giving me an Object 400 error.

VBA Code:
Sub allocationtransfer()

        Dim DialogBox As FileDialog
        Dim path As String

        Set DialogBox = Application.FileDialog(msoFileDialogFilePicker)
        
        DialogBox.Title = "Select file for " & FileType
        DialogBox.Filters.Clear
        DialogBox.Show


        If DialogBox.SelectedItems.Count = 1 Then

        path = DialogBox.SelectedItems(1)

        End If

        ThisWorkbook.Names("File_Path").RefersToRange.Value = path
        
        ActiveWorkbooks.Activate
        ActiveWorkbooks.Open
        
        Dim ws As Worksheet
        Dim wb As Workbook
       
        CurDir = "C:\Users\Privacy\Privacy\Documents\Projects\PayrollTimeSheets\"
        datarngtable = wb.ws.Range("A1:I22")
        
        For Each wb In CurDir
        
            Set tmws = ThisWorkbook.Worksheets("Time Cards")
            
            LastRow = tmws.Range("A" & Rows.Count).End(xlUp).Row
            
            LastRow.Offset(2, 0).Value = Application.WorksheetFunction.VLookup( _
            tmws.Range("A2").Value, datarngtable, 2, False)
        Next
        
End Sub

Any help would be appreciated. Thanks :).
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Hi,

I've also worked on the bottom code trying to achieve the same result as the code above but using a different method. The below code is not done but is the method I'm trying to work out before moving forward.

-Here I am looping through all files in the same folder with "Time-Card" in their name.
-After opening the file I would like to copy the sheet corresponding to the value in cell A2 from an allocations file with employee #'s for sheet names into the looped file that was open.
-Then I would like to do a simple copy and paste of the table from the employee #'s sheet into the bottom of the "Time Card" sheet.

VBA Code:
Sub allocationtransfer2()

Dim FSO As Object
Dim fld As Object
Dim fl As Object
Dim allocations As Workbook
Dim wb As Workbook

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder("C:\Users\private\Documents\Projects\PayrollTimeSheets\")
   
For Each fl In fld.Files
       
        If fl.Name Like "*Time-Card*" Then
           
            Set wb = Workbooks.Open(fl.path)
           
            Set allocations = Workbooks.Open("C:\Users\private\Documents\Projects\PayrollTimeSheets\allocations.xlsx")
            allocations.Sheets(wb.Sheets("Time Card").Range("A2").Value).Copy After:=wb.Sheets(wb.Sheets.Count)
            allocations.Close
           
        End If
Next fl
   
End Sub

Again, any help would be much appreciated. Thanks :).
 
Upvote 0
Hello,

I've changed my method a bit. I'm trying to copy a sheet/workbook to the end of another workbook that is named the same as the value in cell range A2 of the workbook.

Simply put, workbook A has a value in range A2 that workbook B is named. I would like to copy workbook B to workbook A as a sheet appended to the end of the workbook, OR if possible, the contents of workbook B appended to the bottom of the first sheet of workbook A.

I'm not sure of how to go about doing this.

Below is a slight edit of the code in the above post.

VBA Code:
Sub allocationtransfer2()

Dim FSO As Object
Dim fld As Object
Dim fl As Object
Dim fl2 As Object
Dim allocations As Workbook
Dim wb As Workbook

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder("C:\Users\anthony\OneDrive - Aids Center of Queens County\Documents\Projects\PayrollTimeSheets\")
    
For Each fl In fld.Files
        
        If fl.Name Like "*Time-Card*" Then
            
               If Sheet.Name = "Time Card" Then
                For Each fl2 In fld.Files
                
                Set wb = ActiveWorkbook.Sheet("Time Card").Range("A2")
                wb.Sheets("Sheet1").Copy After:=wb.Sheets(wb.Sheets.Count)
                wb.Sheets("Sheet1").Close
                
                Next fl2
                End If
        
        End If
Next fl
    
End Sub

Again, any help would be appreciated. Thanks :)
 
Upvote 0
VBA Code:
Sub allocationtransfer2()

Dim FSO As Object
Dim fld As Object
Dim fl As Object
Dim allocations As Workbook
Dim wb As Workbook
Dim ws As Worksheet
Dim sheetvalue As String
Dim LastR As Range

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder("C:\Users\private\private\Documents\Projects\PayrollTimeSheets")
   
For Each fl In fld.Files
       
        If fl.Name Like "*Time-Card*" Then
           
            Set wb = Workbooks.Open(fl.path)
            
            sheetvalue = Workbooks(fl.Name).Worksheets("Time Card").Range("A2")
            
            Set allocations = Workbooks.Open("C:\Users\private\private\Documents\Projects\PayrollTimeSheets\allocations.xlsx")
            allocations.Sheets(sheetvalue).Copy AFTER:=wb.Sheets(wb.Sheets.Count)
            allocations.Close
            wb.Sheets(sheetvalue).Name = "Allocations"
            
          
            wb.Close
            
        End If
 
Next fl
 
End Sub

If anyone uses this post as an example, I dimmed "sheetvalue" as a range and it worked using the above code.
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,161
Members
453,021
Latest member
Justyna P

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