在已关闭的工作簿中搜索行，然后将行中的特定数据单元格（不是整行）复制到我当前的工作簿中

Question

我是这个网站的新手，一般来说是 VBA 的新手，我正在寻找任何可能的帮助吗？如果可能的话！？

我正在尝试根据参考匹配将单元格数据从一张纸复制到另一张纸。

基本上，我想使用参考号在已关闭的工作簿中搜索一行，然后将该行中的某些单元格（不是整行）复制到我打开的工作簿的某些单元格中。

我认为点击按钮是最好的方法？

所以将参考插入打开的工作簿，单击按钮并从关闭的工作簿中提取数据..（在纸上听起来很容易！哈）

例如。

搜索参考号- 123456

搜索此参考号。对于已关闭工作簿“每周统计”中的特定行，然后仅将该特定行中的单元格 - D2、E2、F2、G2 和 S2 复制到当前打开的工作簿中。

这可能吗？会节省我很多时间！

任何帮助表示赞赏！

谢谢，

Answer 1

将此粘贴​​到您的工作表代码中，例如 Sheet1(Sheet1)，调整输入单元格和路径。 如果未更改，则通过更改单元格 A1 中的值进行测试。 包括一些替代方案，用于试验、添加和删除刻度（s）（'）以进行修改。 解释行上的双勾（''）（不是代码）不要弄乱这些.. 当达到您的首选结果时，删除未使用的替代项（绿色）

    Private Sub Worksheet_Change(ByVal Target As Range)
                                    ''-Select input cell here
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        If Target.Value <> "" Then
            ''-Turns off visual updating
            Application.ScreenUpdating = False

            ''-Returns value applied in input cell later used as row reference.
            rwnum = Target.Value

            Dim wb As Workbook

            ''Alt 1'For user selected workbook
            'Dim dP As String
            'dP = Environ$("USERPROFILE") & "\" & "Downloads": ChDrive "C:"
            'ChDir dP
            'Dim fNP As Variant
            'fNP = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select file")
            'Set wb = Workbooks.Open(fNP)


            ''Alt 2'For static workbook name with static path
                                    '               Your path here               '
            Set wb = Workbooks.Open("C:\Users\Drew\Downloads\Weekly stats.xls")


            ''Alt 3'For static workbook name with semi dynamical path
            'Set wb = Workbooks.Open(Environ$("USERPROFILE") & "\" & "Downloads\" & "Weekly stats.xls")
                                    'C:\Users\UserName         \     Downloads\     Weekly stats.xls


            Dim rng As Range
            Set rng = wb.ActiveSheet.Range("A1").CurrentRegion

            ''Alt 1'Static columns, select yours! 1=column A, 2=column B and so on..
            c1 = 1:     c2 = 2:    c3 = 3:    c4 = 4:    c5 = 16

            ''Alt 2'Dynamic columns, if entire columns would move for some reason
            'With rng
            '    c1 = WorksheetFunction.Match("Example header text 1", .Rows(1), 0)
            '    c2 = WorksheetFunction.Match("Example header text 2", .Rows(1), 0)
            '    c3 = WorksheetFunction.Match("Example header text 3", .Rows(1), 0)
            '    c4 = WorksheetFunction.Match("Example header text 4", .Rows(1), 0)
            '    c5 = WorksheetFunction.Match("Example header text 5", .Rows(1), 0)
            'End With

            Dim Mrng As Range
            ''-Where content is "pasted" 
            ''Alt 1'Static destination
            'Set Mrng = Me.Range("D2:S2")

            ''Alt 2'Same row as in closed workbook and columns 4 to 19(D:S)
            'Set Mrng = Me.Cells(rwnum, 4).Resize(, 16)

            ''Alt 3'Next empty row in columns 4 to 19(D:S)
            Set Mrng = Me.Range("D1048576").End(xlUp).Offset(1).Resize(, 16)


            ''-Adds the value to earlier selected columns in above selected row
            With Mrng   
                .Cells(c1).Value = rng(rwnum, c1)
                .Cells(c2).Value = rng(rwnum, c2)
                .Cells(c3).Value = rng(rwnum, c3)
                .Cells(c4).Value = rng(rwnum, c4)
                .Cells(c5).Value = rng(rwnum, c5)
            End With

            ''-Closes the "closed workbook" without saving any changes
            wb.Close savechanges:=False

            ''-Returns selection to input cell for further testing 
            Target.Select

            ''-Turns on visual updating                
            Application.ScreenUpdating = True
        End If
    End If
End Sub