0
votes

My code will loop through all files in folder and copy information into selected cells from a sheet 'Manager Form' to a masterfile. When I want to add more ranges to copy, it blocks me with error.

The issue is with this line:
NewSht.Range("B" & PasteRow).PasteSpecial xlPasteValues

How should I specify the range to paste?

Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim Masterwb  As Workbook
Dim sh As Worksheet
Dim NewSht As Worksheet
Dim OldSht As Worksheet
Dim FindRng As Range
Dim PasteRow As Long

' set master workbook
Set Masterwb = Workbooks("result2.xlsm")

folderPath = "C:\Users\Downloads\Tech\TimeSheets2019\inside" 'contains folder path

If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Application.ScreenUpdating = False

Filename = Dir(folderPath & "*.xlsx*")
Do While Filename <> ""
    Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True)
    Set NewSht = Masterwb.Worksheets("Tabelle1") ' added
    Set OldSht = wb.Worksheets("Manager Form") ' added

    ' get the first empty row in the new sheet
        Set FindRng = NewSht.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)

        If Not FindRng Is Nothing Then ' If find is successful
            PasteRow = FindRng.Row + 1
        Else ' find was unsuccessfull > new empty sheet, should paste at the first row
            PasteRow = 1
        End If

        OldSht.Range("B7").Copy

        NewSht.Range("B" & PasteRow).PasteSpecial xlPasteValues

    wb.Close False
1
What is the value of PasteRow when it errors?SJR
PasteRow should be first empty row, in this case it is 2nd row in NewShtEve
If you're just pasting values, why not do Range(y).Value = Range(x).Value? It would be significantly faster.Tim Stack
Are you saying it is 2 or it should be 2?SJR
My code should copy 5 ranges from each file and copy it one after another in first free row in NewSht. It will contain Name, time, date etc. Currently first empty row is second row, but nothing gets pasted.Eve

1 Answers

0
votes
' get the first empty row in the new sheet
 Dim target as range
 Set target = newsht.cells(NewSht.usedrange.rows.count +1,2)

OR

 Dim target as Range
 Set target = newsht.cells(newsht.rows.count,2).end(xlup).offset(1,0)

Then

  target.formula = OldSht.Range("B7").value  'copy value into blank cell