Cześć,
stworzyłam kod który ma na celu
- wybór arkusza z folderu
- skopiowanie z niego wybranych danych do poszczególnych kolumn
To jakie dane zostaną skopiowane zależy od dwóch rzeczy - od treści znajdującej się w arkuszu do którego będą kopiowane dane: wsCopyTo.Range("B17") = "K 01" oraz od treści w arkuszu z którego kopiuję - czy jest tam w kolumnie obok symbol k czy m.
Niestety makro wyświetla mi komunikat Run-time error 13 Type mismatch. Wcześniej, przed wprowadzeniem funkcji if wszystko działało... jak naprawić te błędy?
Sub PobierzDane()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied
Dim str_folder As String
ChDir "C:\Users\LEN\Desktop"
vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", False)
'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If
'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("E3").Copy
wsCopyTo.Range("A5").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("G4").Copy
wsCopyTo.Range("A7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("G4").Copy
wsCopyTo.Range("H5").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("C2").Copy
wsCopyTo.Range("I5").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
If wsCopyTo.Range("B17") = "K 01" And wsCopyFrom.Range("F10:F29") = "K" Then
wsCopyFrom.Range("D10:D29").Copy
wsCopyTo.Range("G32:G53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("E10:E29").Copy
wsCopyTo.Range("H32:H53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("B10:B29").Copy
wsCopyTo.Range("A32:A53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
If wsCopyTo.Range("B17") = "M 02" And wsCopyFrom.Range("F10:F29") = "M" Then
wsCopyFrom.Range("D10:D29").Copy
wsCopyTo.Range("G32:G53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("E10:E29").Copy
wsCopyTo.Range("H32:H53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("B10:B29").Copy
wsCopyTo.Range("A32:A53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
'Close file that was opened
wbCopyFrom.Close SaveChanges:=False
End Sub