I am trying to copy some data from one workbook to another, with checking certain cells content from 2 files. Below is my code:
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
It gets runtime 438 error in this line:
Msc = SrcWbk.Cells(2, 13).Text
The script have to get text parameter from source workbook cell 2,13, then take number for this text from array. Then scrip has to get text parameter from destination work book cell 3,4 and search for it in source workbook. Then I can copy some data.
This covers most of the comments. I think it should work, but you might have to check the workbook/sheet names as I wasn't entirely clear in all cases.
And check I have the wiersz_nazw
bit correct.
The original 438 error was caused because Cells
needs a sheet parent, not a workbook parent.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.