VBA Paste Special and finding the next empty row

Roybzer

New Member
Joined
Apr 30, 2013
Messages
16
Office Version
  1. 365
Platform
  1. MacOS
I'm trying to create a master spreadsheet that collates worker timesheets from 100+ workers, onto a single master spreadsheet(pasted to 1 sheet, not to separate sheets).

I've managed to get it to the point(with a jigsaw of borrowed code), where the timesheets do paste in to the one master sheet, however, it is doing so with formulas, resulting in errors everywhere.

Also, I'm using a crude counter to increment count to create a new row number to start the next paste.

Is there a way to change the below to paste values, and to start the next paste from the next blank row?

Public Sub ImportActiveList()
Dim FileNames As Variant
Dim FileName As Variant
Dim masterTS As Worksheet
Dim ActiveTS As Workbook
Dim count As Integer

Set masterTS = ActiveWorkbook.Sheets("Sheet1")

FileNames = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select Active List to Import", _
MultiSelect:=True)
If VarType(FileNames) = vbBoolean Then
If Not FileNames Then Exit Sub
End If
count = 1

For Each FileName In FileNames
Set ActiveTS = Workbooks.Open(FileName)
ActiveTS.Sheets("Timesheet").UsedRange.Copy masterTS.Range("A" & count)
ActiveTS.Close False
count = count + 100
Next FileName
End Sub
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,729
Office Version
  1. 365
Platform
  1. Windows
Try:
Code:
Public Sub ImportActiveList_1()

    Dim FileNames   As Variant
    Dim arr()       As Variant
    Dim x           As Long
    Dim wkb         As Workbook
    
    With Application
        FileNames = .GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Select Active List to Import", , True)
        If VarType(FileNames) = vbBoolean Or Not FileNames Then Exit Sub
        .ScreenUpdating = False
    End With
    
    For x = LBound(FileNames) To UBound(FileNames)
        Set wkb = Workbooks.Open(FileNames(x), ReadOnly:=True)
        With wkb
            arr = .Sheets("Timesheet").UsedRange.Value
            .Close False
        End With
        Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Set wkb = Nothing
        Erase arr
    Next x
    
    With Sheets("Sheet1")
        If .Cells(1, 1).End(xlToRight).column = .Cells.Columns.count Then .Cells(1, 1).EntireRow.Delete
    End With
    
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:

Roybzer

New Member
Joined
Apr 30, 2013
Messages
16
Office Version
  1. 365
Platform
  1. MacOS
Thanks JackDanIce,

It's throwing a type mismatch error with the validation of FileNames file type, and I'm not sure why:

If VarType(FileNames) = vbBoolean Or Not FileNames Then Exit Sub
 

JackDanIce

Well-known Member
Joined
Feb 3, 2010
Messages
9,729
Office Version
  1. 365
Platform
  1. Windows
Try:
Code:
Public Sub ImportActiveList_1()


    Dim FileNames   As Variant
    Dim arr()       As Variant
    Dim x           As Long
    Dim wkb         As Workbook
        
    FileNames = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*", , "Select Active List to Import", , True)
    If VarType(FileNames) = vbBoolean Or Not FileNames Then Exit Sub
        
    Application.ScreenUpdating = False
        
    For x = LBound(FileNames) To UBound(FileNames)
        Set wkb = Workbooks.Open(FileNames(x), ReadOnly:=True)
        With wkb
            arr = .Sheets("Timesheet").UsedRange.Value
            .Close False
        End With
        Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Set wkb = Nothing
        Erase arr
    Next x
    
    With Sheets("Sheet1")
        If .Cells(1, 1).End(xlToRight).column = .Cells.Columns.count Then .Cells(1, 1).EntireRow.Delete
    End With
    
    Application.ScreenUpdating = True
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,650
Messages
5,626,087
Members
416,161
Latest member
David1966Lewis

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