Копирование из одной рабочей книги в другую с проверкой ячеек

Question

Я пытаюсь скопировать некоторые данные из одной рабочей книги в другую с проверкой содержимого определенных ячеек из 2 файлов. Ниже приведен мой код:

    Sub GetFileCopyData()
   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook
   Dim miesiac() As Variant
   Dim m_i, i, wiersz_nazw As Integer
   Dim Msc, nazw As String

   miesiac = Array(styczeń, luty, marzec, kwiecień, maj, czerwiec, lipiec, sierpień, wrzesień, październik, listopad, grudzień)

   Set DestWbk = ThisWorkbook
   Set SrcWbk = ActiveWorkbook
   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)
   Set DestWbk = ActiveWorkbook


   Msc = SrcWbk.Cells(2, 13).Text
   m_i = szukaj(miesiac, Msc)


   nazw = Cells(3, 4).Text
   For i = 1 To 100 Step 1
        If nazw Like "*" & SrcWbk.Cells(i, 24) & "*" Then
            wiersz_nazw = i: Exit For
        End If
   Next

   SrcWbk.Cells(wiersz_nazw, 2).Copy DestWbk.Cells(m_i + 7, 3)

End Sub

Function szukaj(ByRef lista As Variant, ByVal wartosc As String)
  Dim found As Integer, foundi As Integer ' put only once
  found = -1
  For foundi = LBound(lista) To UBound(lista):
   'If lista(foundi) = wartosc   Then
   If StrComp(lista(foundi), wartosc, vbTextCompare) = 0 Then
    found = foundi: Exit For
   End If
  Next
  szukaj = found
End Function

В этой строке выдается ошибка времени исполнения 438:

Msc = SrcWbk.Cells(2, 13).Text

Сценарий должен получить текстовый параметр из исходной ячейки рабочей книги 2,13, затем взять число для этого текста из массива. Затем скрипт должен получить текстовый параметр из целевой ячейки рабочей книги 3,4 и найти его в исходной рабочей книге. Тогда я могу скопировать некоторые данные.

Answer 1

Это покрывает большую часть комментариев. Я думаю, что это должно сработать, но вам, возможно, придется проверить названия книг / листов, поскольку я не совсем ясно во всех случаях.

И проверить, что у меня правильный бит wiersz_nazw.

Первоначальная ошибка 438 была вызвана тем, что Cells нужен родительский элемент листа, а не родительский элемент книги.

Sub GetFileCopyData()

Dim Fname As String
Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim miesiac() As Variant
Dim m_i As Variant, i As Long, wiersz_nazw As Variant
Dim Msc As String, nazw As String 'each one needs to be specified

miesiac = Array(styczen, luty, marzec, kwiecien, maj, czerwiec, lipiec, sierpien, wrzesien, pazdziernik, listopad, grudzien)

Set DestWbk = ThisWorkbook 'file containing code
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
If Fname = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(Fname)

Msc = SrcWbk.Worksheets(1).Cells(2, 13).Text
m_i = Application.Match(Msc, miesiac, 0)

If Not IsNumeric(m_i) Then m_i = -1
nazw = SrcWbk.Worksheets(1).Cells(3, 4).Text 'change workbook/sheet as necessary
wiersz_nazw = Application.Match("*" & nazw & "*", SrcWbk.Worksheets(1).Range("X1:X100"), 0)
If IsNumeric(wiersz_nazw) Then
    SrcWbk.Worksheets(1).Cells(wiersz_nazw, 2).Copy DestWbk.Worksheets(1).Cells(m_i + 7, 3) 'change sheets as necessary
End If

End Sub