Мой код будет перебирать все файлы в папке и копировать информацию в выбранные ячейки из листа «Форма менеджера» в мастер-файл.Когда я хочу добавить дополнительные диапазоны для копирования, он блокирует меня с ошибкой.
Проблема с этой строкой:
NewSht.Range ("B" & PasteRow) .PasteSpecial xlPasteValues
Как мне указать диапазон для вставки?
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