VBA使用文件对话框进行搜索，然后复制并粘贴

Question

Right now my code copies & pastes all of the data without any specific selection criteria. I'm trying to copy and paste specific information from certain files based upon their name into the active worksheet. I believe there is some function that I need that can help me with this. Any help would be great. Thanks.

Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set wbb = ThisWorkbook
Set sh = wbb.Worksheets("Sheet1")

With fd
    .Title = "Please select Job Folder"
    .AllowMultiSelect = True
    Err.Clear
    FileChosen = fd.Show
    If MsgBox("Files selected, continue?", vbYesNo) = vbNo Then Exit Sub

    For i = 1 To fd.SelectedItems.Count
        file = fd.SelectedItems(i)
        Workbooks.Open Filename:=file, ReadOnly:=True
        If file = "" Then Exit Sub
        filesheet = "Sheet1"
        ActiveWorkbook.Sheets(filesheet).Range("A1:A3").Copy
        LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
        sh.Cells(sh.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ActiveWorkbook.Close savechanges:=False
    Next i
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

But you already have the answer on the posted sheet!

To check for a string within another string, use the InStr() function:

If InStr(CStr(file), "PartOfFileName") <> 0 Then
  'file found, copy specific parts to that file
End If

Here are some more good examples on how to use the function.

It is advised to 'Dim' all your variables to have better control over your code.