Неизвестно Runtime Ошибка возникает при настройке диапазона

Question

Это подпрограмма более крупной программы (я могу скопировать и вставить всю вещь, если необходимо). Я получаю неизвестную ошибку времени выполнения, и я не могу понять, почему. Я провел пару часов, расстраиваясь, и решил прийти к вам, ребята, за помощью!

Quick Edit: Я пытаюсь найти конкретный заголовок столбца, а затем выберите весь столбец (минус заголовок) в качестве диапазона.

Sub YearSmash(MyString) 
    With objSheetSrc 
     Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1) 
     If FoundCell Is Nothing Then 
      Exit Sub 
     End If 

     MsgBox(FoundCell) 

     Set rng1 = .Range(FoundCell.Offset(1), FoundCell.Offset(1).End(xlDown)) 

     MsgBox(rng1) 
    End With 
End Sub 

Ошибка встречающийся на следующей строке:

Set rng1 = .Range(FoundCell.Offset(1), FoundCell.Offset(1).End(xlDown)) 

Есть идеи? Кроме того, в данных, которые я пытаюсь извлечь, нет недопустимых значений, ошибок или значений NULL.

Спасибо,

Эндрю

Editted показать код в полном объеме:

Const xlFilterCopy = 2 
strPathSrc = "C:\test" ' Source files folder 
strMaskSrc = "*.xlsx" ' Source files filter mask 

dtmDate = Date 
strMonth = Month(Date) 
strDay = Day(Date) 
strYear = Right(Year(Date), 2) 
strFileName = "C:\test\Results\" & strMonth & "-" & StrDay & "-" & strYear & " Results.xlsx" 
Set objExcel = CreateObject("Excel.Application") 
objExcel.Visible = False 

Set objWorkbook = objExcel.Workbooks.Add() 
objWorkbook.SaveAs(strFileName) 
objExcel.Quit 

'strPathDst = "C:\test\Results\Results.xlsx" ' Destination file 
strPathDst = strFileName 

Set objExcel = CreateObject("Excel.Application") 
objExcel.Visible = False 
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst) 
Set objShellApp = CreateObject("Shell.Application") 
Set objFolder = objShellApp.NameSpace(strPathSrc) 
Set objItems = objFolder.Items() 
objItems.Filter 64 + 128, strMaskSrc 
objExcel.DisplayAlerts = False 
x = 1 
y = 1 
MsgBox("Working") 
For Each objItem In objItems 
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path) 
    Set objSheetSrc = objWorkBookSrc.Sheets(1) 
    Set objSheetDst = objWorkBookDst.Sheets(1) 
    For Each Cell In objSheetSrc.Range("A1:Z15") 
     If Cell.MergeCells = True Then 
      Set objRange = Cell.EntireRow 
      objRange.Delete 
     End If 
    Next 

    'Set FoundCell = objSheetSrc.Range("A1:BZ1").Find("Device", , , 1) 

    'For Each Cell In objSheetSrc.Range(FoundCell.Offset(1,0), objSheetSrc.Cells(objSheetSrc.Rows.Count, FoundCell.Column).End(-4162)).Cells 
     'If Cell.Value <> "*MSP430*" Then 
     ' Cell.EntireRow.Delete 
     'End If 
    'Next 

    Set objSheetDst = objWorkBookDst.Sheets(1) 

    Call FindCell("Sales Region") 
    Call FindCell("Sales Area") 
    Call FindCell("TSR Role") 
    Call FindCell("My Account") 
    Call FindCell("Account Class") 
    Call FindCell("Project Name") 
    Call FindCell("Device") 
    Call FindCell("AUP") 
    Call FindCell("Qty Per Board") 
    Call FindCell("Device Status") 
    Call FindCell("Project Status") 
    Call FindCell("Project Kickoff") 
    Call FindCell("Market") 
    Call FindCell("SBE") 
    Call FindCell("SBE-1") 
    Call FindCell("SBE-2") 
    Call FindCell("2013 Q1") 
    Call FindCell("2013 Q2") 
    Call FindCell("2013 Q3") 
    Call FindCell("2013 Q4") 
    Call FindCell("2014 Q1") 
    Call FindCell("2014 Q2") 
    Call FindCell("2014 Q3") 
    Call FindCell("2014 Q4") 
    Call FindCell("2015 Q1") 
    Call FindCell("2015 Q2") 
    Call FindCell("2015 Q3") 
    Call FindCell("2015 Q4") 
    Call FindCell("2016") 
    Call YearSmash("2016 Q1") 
    Call FindCell("2016 Q1") 
    Call FindCell("2017") 
    Call FindCell("2018") 

    objWorkBookSrc.Close 
Next 

objExcel.Visible = True 

Sub FindCell(MyString) 
    Do While objSheetDst.Cells(x, y).Value <> "" 
     y = y + 1 
    Loop 

    If MyString = "Sales Region" And y > 2 Then 
     y = 1 
     Do While objSheetDst.Cells(x, y).Value <> "" 
      x = x + 1 
     Loop 
    End If 

    Set FoundCell = objSheetSrc.Range("A1:BZ1").Find(MyString, , , 1) 
    If FoundCell Is Nothing Then 
     Exit Sub 
    End If 

    Set objRangeSrc = FoundCell.EntireColumn 
    objRangeSrc.AdvancedFilter xlFilterCopy, , objSheetDst.Cells(x, y), False 
End Sub 

Sub YearSmash(MyString) 
    With objSheetSrc 
     Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1) 
     If FoundCell Is Nothing Then Exit Sub 

     Set lRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row 

     Set rng1 = .Range(.Cells(FoundCell.Row + 1, FoundCell.Column), .Cells(lRow, FoundCell.Column)) 

     MsgBox rng1.Address 
    End With 
End Sub 

Answer 1

Это то, что вы пытаетесь?

Sub YearSmash(MyString) 
    Dim objSheetSrc As Worksheet 
    Dim lRow As Long 
    Dim FoundCell As Range, rng1 As Range 
    Dim MyString As String 

    '~~> Change as applicable 
    Set objSheetSrc = ThisWorkbook.Sheets("Sheet1") 

    With objSheetSrc 
     Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1) 

     If FoundCell Is Nothing Then Exit Sub 

     '~~> Find the last row in that column 
     lRow = .Cells(.Rows.Count, FoundCell.Column).End(xlUp).Row 

     '~~> Construct your range from one cell offset 
     Set rng1 = .Range(.Cells(FoundCell.Row + 1, FoundCell.Column), _ 
          .Cells(lRow, FoundCell.Column)) 

     MsgBox rng1.Address 
    End With 
End Sub 

Followup ОТ КОММЕНТАРИЕВ

Я проверил это в VBScript, и это работает прекрасно

Dim oXLApp, olXLWb, objSheetSrc 
Dim MyString, lRow, FoundCell, rng1 

Set oXLApp = CreateObject("Excel.Application") 

oXLApp.Visible = True 

'~~> Sample File 
Set olXLWb = oXLApp.Workbooks.Open("C:\Sample.xlsx") 

'~~> Change as applicable 
Set objSheetSrc = olXLWb.Sheets("Sheet1") 

'~~> Sample String 
MyString = "Sid" 

With objSheetSrc 
    Set FoundCell = .Range("A1:BZ1").Find(MyString, , , 1) 

    If Not FoundCell Is Nothing Then 
     '~~> Find the last row in that column 
     lRow = .Cells(.Rows.Count, FoundCell.Column).End(-4162).Row 

     '~~> Construct your range from one cell offset 
     Set rng1 = .Range(.Cells(FoundCell.Row + 1, FoundCell.Column), _ 
          .Cells(lRow, FoundCell.Column)) 

     MsgBox rng1.Address 
    End If 
End With