Question

我的代码将遍历文件夹中的所有文件，并将信息从“管理器表单”工作表复制到选定的单元格中，再复制到主文件中。当我想添加更多范围进行复制时，它会错误地阻止我。

问题在于此行：
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

Answer 1

' 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)

然后

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

运行时1004：粘贴时对象“工作表”的方法“范围”失败

1 个答案: