Database 数据挖掘宏将值从多个工作簿复制并粘贴到单个工作簿

这就是我现在要处理的问题。我试图更改此宏以查找特定的值/文本，并将该数据复制到数据挖掘工作簿

当前，此宏复制特定单元格。我基本上想把它改成一个查找和复制函数

我想，如果我能找出如何使“从间隔摘要中查找并复制日期”工作，那么我可以使用该方法更改宏的所有其他部分。该部分有我当前的尝试，使这个宏工作，但我不断得到错误

Public Sub CommandButton1_Click()

' Record job, modular code, multiple customers.

    Dim counter As Integer
    Dim PadPercentage As Single
    Dim Charactercounter As Integer
    Dim Date1 As String
    Dim Date2 As String
    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant
    Dim Designcounter As Integer
    Dim Customer As String
    Dim Chemicals As String
    Dim Chemcounter As Integer
    Dim column As String
    Dim Sand As Integer




    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Designcounter = -1


    With fd

        If .Show = -1 Then

            For Each vrtSelectedItem In .SelectedItems
                Designcounter = Designcounter + 1
                Workbooks.Open Filename:=vrtSelectedItem
                Sheets("Interval Summary").Select
                counter = 4
                Charactercounter = 1


'   Find and Copy date from Interval Summary.
                With Worksheets("Interval Summary")
                    Set FindRow = Range("B:B").Find(What:="Date:", LookIn:=xlPart).Select
                    ActiveCell.Offset(0, 3).Select
                    Selection.Copy
                End With
                Windows("2014 GJ PE Engineering Job Logs - Iteration 1.xls").Activate
                Range("A" & CStr(counter)).Select


'   Search for first blank cell in column A.
                Do While ActiveCell.Value <> ""
                    counter = counter + 1
                    Range("A" & CStr(counter)).PasteSpecial xlPasteValuesAndNumberFormats
                Loop

'   Paste date onto job recording sheet.
                Range("A" & CStr(counter)).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Selection.UnMerge
                Selection.NumberFormat = "m/d/yyyy"

' Record previous engineer name on job recording sheet.
                Range("B" & CStr(counter - 1)).Select
                Selection.Copy
                Range("B" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

'   Copy customer name onto reporting sheet.
                ActiveWindow.ActivatePrevious
                Worksheets("Actual Design").Range("C1").Select
                Customer = ActiveCell.Value
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("E" & CStr(counter)).Select
                ActiveSheet.Paste

'   Paste SO from design onto recording sheet.
                ActiveWindow.ActivateNext
                If Customer = "Noble Energy Inc." Then
                    Worksheets("Design").Range("O1").Select
                Else
                    Worksheets("Design").Range("Q1").Select
                End If
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("C" & CStr(counter)).Select
                ActiveSheet.Paste
                Selection.UnMerge


    Call Lease_Pad_Well_Copy(Customer, counter)



'   Find and Copy Interval # from Well Data
                With Worksheets("Well Data")
                    Set FindRow = .Range("B:B").Find(What:="Date", LookIn:=xlValues)
                Windows("2014 GJ PE Engineering Job Logs.xls").Activate
                Range("A" & CStr(counter)).Select
                End With


'   Copy mid perf depth to reporting sheet.

                Worksheets("Actual").Range("C40").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("I" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False


'   Copy mid perf depth TVD to reporting sheet.

                Worksheets("Actual").Range("C40").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("I" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False


'   Copy Top perf depth to reporting sheet.

                Worksheets("Actual").Range("C40").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("I" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False


'   Copy Bottom perf depth to reporting sheet.

                Worksheets("Actual").Range("C40").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("I" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False


'   Copy formation name to reporting sheet.
                ActiveWindow.ActivateNext
                Worksheets("Design").Range("C3").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("J" & CStr(counter)).Select
                ActiveSheet.Paste


'   Copy fluid system.
                Range("K" & CStr(counter - 1)).Select
                Selection.Copy
                Range("K" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

'   Copy crew from previous job.
                Range("L" & CStr(counter - 1)).Select
                Selection.Copy
                Range("L" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    If Customer = "x3" Or Customer = "Chevron" Then
        Call Copy_x3_Data(Customer, counter)
    End If

    If Customer = "x1." Then
        Call Copyx1_Data(Customer, counter)
    End If

    If Customer = "x2" Then
        Call Copy_x2(Customer, counter)
    End If

'   Copy slurry volume

                If Customer = "Williams Prod RMT" Then
                    ActiveWindow.ActivateNext
                    Sheets("Actuals").Select
                    Worksheets("Actuals").Range("H30").Select
                    Selection.Copy
                Else
                    ActiveWindow.ActivateNext
                    Sheets("Design").Select
                    Worksheets("Design").Range("H30").Select
                    Selection.Copy
                End If
                    ActiveWindow.ActivatePrevious
                    Range("S" & CStr(counter)).Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False



    '   Copy chemicals from design to Job recording sheet.
                ActiveWindow.ActivateNext
                Chemcounter = 78
                column = Chr(Chemcounter)
                Sheets("Well Data").Select
                Worksheets("Design").Range(column & "5").Select
                Do While ActiveCell.Value <> ""
                    If Chemcounter < 79 Then Chemicals = ActiveCell.Value
                    If Chemcounter > 78 Then Chemicals = Chemicals & ", " & ActiveCell.Value
                    Chemcounter = Chemcounter + 1
                    column = Chr(Chemcounter)
                    Worksheets("Well Data").Range(column & "5").Select
                Loop
                ActiveWindow.ActivatePrevious
                Range("P" & CStr(counter)).Select
                ActiveCell.Value = Chemicals



'   Switch back to and close design
                ActiveWindow.ActivateNext
                ActiveWorkbook.Save
                ActiveWindow.Close

            Next vrtSelectedItem
        End If
    End With

'   Format job log entries.
                ActiveWindow.ActivatePrevious
                Range("A" & CStr(counter - Designcounter) & ":AE" & CStr(counter)).Select
                Application.CutCopyMode = False
                With Selection.Font
                    .Name = "Arial"
                    .Size = 10
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                    .ColorIndex = xlAutomatic
                End With
                Selection.Font.Bold = False
                Rows(CStr(counter) & ":" & CStr(counter)).Select
                Selection.RowHeight = 13.5



End Sub



Sub Lease_Pad_Well_Copy(Customer, counter)

    Dim Wellstrng As String
    Dim Pad As String
    Dim Wellpad As String
    Dim Lease As String
    Dim Well As String



    If Customer = "x5" Or Customer = "x6" Or Customer = "Noble Energy Inc." Or Customer = "x2" Then
    '   Sort lease, well, and pad number and copy to reporting sheet.
                ActiveWindow.ActivateNext
                Worksheets("Design").Range("C2").Select
                If ActiveCell.Value <> "" Then
                    Wellstrng = ActiveCell.Value
                    Lease = Left(Wellstrng, CLng(InStr(Wellstrng, " ")) - 1)
                    Pad = Right(Wellstrng, Len(Wellstrng) - CLng(InStrRev(Wellstrng, "-")))
                    Wellpad = Left(Wellstrng, CLng(InStr(Wellstrng, "-")) - 1)
                    Well = Right(Wellpad, Len(Wellpad) - CLng(InStrRev(Wellpad, " ")))



                    If Customer = "Noble Energy Inc." Then

                        Wellstrng = ActiveCell.Value
                        Lease = Left(Wellstrng, CLng(InStr(Wellstrng, " ")) - 1)
                        Wellpad = Right(Wellstrng, Len(Wellstrng) - CLng(InStr(Wellstrng, " ")))
                        Wellpad = Left(Wellpad, Len(Wellpad) - CLng(InStrRev(Wellpad, " -")))
                        Pad = Left(Wellpad, CLng(InStr(Wellpad, "-")) - 1)
                        Wellpad = Left(Wellstrng, CLng(InStr(Wellstrng, " -")) - 1)
                        Well = Right(Wellpad, Len(Wellpad) - CLng(InStrRev(Wellpad, "-")))

                    End If

                    If Customer = "x2." Then
                        Wellstrng = ActiveCell.Value
                        Lease = Left(Wellstrng, CLng(InStr(Wellstrng, " ")) - 1)
                        Pad = Right(Wellstrng, Len(Wellstrng) - CLng(InStr(Wellstrng, "-")))
                        Wellpad = Left(Wellstrng, CLng(InStr(Wellstrng, "-")) - 1)
                        Well = Right(Wellpad, Len(Wellpad) - CLng(InStrRev(Wellpad, " ")))
                    End If



                    ActiveWindow.ActivatePrevious



    '   Copy lease name onto reporting sheet.
                    Range("F" & CStr(counter)).Select
                    ActiveCell.Value = Lease

    '   Copy well number onto reporting sheet.
                    Range("G" & CStr(counter)).Select
                    ActiveCell.Value = Well

    '   Copy pad onto reporting sheet.
                    Range("H" & CStr(counter)).Select
                    ActiveCell.Value = Pad
                    ActiveWindow.ActivateNext
                End If

    End If


End Sub




Sub Copy_BBC(Customer, counter)

    Dim Twosands As String
    Dim Sandint As Integer

    '   Copy average rate
            ActiveWindow.ActivateNext
            Sheets("Database").Select
            Worksheets("Database").Range("B16").Select
            Selection.Copy
            ActiveWindow.ActivatePrevious
            Range("M" & CStr(counter)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy average pressure
            ActiveWindow.ActivateNext
            Worksheets("Database").Range("B17").Select
            Selection.Copy
            ActiveWindow.ActivatePrevious
            Range("N" & CStr(counter)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy perfs open.
            ActiveWindow.ActivateNext
            Worksheets("Database").Range("G18").Select
            Selection.Copy
            ActiveWindow.ActivatePrevious
            Range("W" & CStr(counter)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy actual sand
            ActiveWindow.ActivateNext
            Worksheets("Database").Range("B26").Select
            Twosands = ActiveCell.Value
            Twosands = Twosands & " / "
            Worksheets("Database").Range("B28").Select
            Twosands = Twosands & ActiveCell.Value
            ActiveWindow.ActivatePrevious
            Range("Q" & CStr(counter)).Select
            ActiveCell.Value = Twosands


    '   Copy initial frac gradient
            ActiveWindow.ActivateNext
            Sheets("Database").Select
            Worksheets("Database").Range("B21").Select
            Selection.Copy
            ActiveWindow.ActivatePrevious
            Range("V" & CStr(counter)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy final frac gradient
            ActiveWindow.ActivateNext
            Worksheets("Database").Range("B23").Select
            Selection.Copy
            ActiveWindow.ActivatePrevious
            Range("Y" & CStr(counter)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy ISIP
            ActiveWindow.ActivateNext
            Worksheets("Database").Range("B20").Select
            Selection.Copy
            ActiveWindow.ActivatePrevious
            Range("U" & CStr(counter)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy ISDP
            ActiveWindow.ActivateNext
            Worksheets("Database").Range("B22").Select
            Selection.Copy
            ActiveWindow.ActivatePrevious
            Range("X" & CStr(counter)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False



End Sub

Sub Copy_Williams_Data(Customer, counter)


    '   Copy average rate to reporting sheet.
                ActiveWindow.ActivateNext
                Sheets("Actuals").Select
                Worksheets("Actuals").Range("G63").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("M" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy average pressure to reporting sheet.
                ActiveWindow.ActivateNext
                Worksheets("Actuals").Range("F63").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("N" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy perfs open.
                ActiveWindow.ActivateNext
                Worksheets("Actuals").Range("D64").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("W" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy actual sand
                ActiveWindow.ActivateNext
                Worksheets("Actuals").Range("D65").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("Q" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy initial frac gradient
                ActiveWindow.ActivateNext
                Sheets("Actuals").Select
                Worksheets("Design").Range("D61").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("V" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy final frac gradient
                ActiveWindow.ActivateNext
                Worksheets("Actuals").Range("D63").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("Y" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy ISIP
                ActiveWindow.ActivateNext
                Worksheets("Actuals").Range("D60").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("U" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy ISDP
                ActiveWindow.ActivateNext
                Worksheets("Actuals").Range("D62").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("X" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

End Sub

Sub Copy_x4_(Customer, counter)

    Dim SandColor As String
    Dim Sieve As String
    Dim Sandtemp As String
    Dim Sandtype As String

    '   Copy average rate to reporting sheet.
                ActiveWindow.ActivateNext
                Sheets("Actuals Design").Select
                Worksheets("Actual Design").Range("H63").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("M" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy average pressure to reporting sheet.
                ActiveWindow.ActivateNext
                Worksheets("Actual Design").Range("H62").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("N" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

   '   Copy Total perfs open.
                ActiveWindow.ActivateNext
                Worksheets("Actual Design").Range("E65").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("W" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

     '   Copy actual sand.
                ActiveWindow.ActivateNext
                Worksheets("Design").Range("M61").Select
                Greensand = ActiveCell.Value
                Worksheets("Design").Range("M60").Select
                Whitesand = ActiveCell.Value & " / "
                Combinedsand = Whitesand & Greensand
                ActiveWindow.ActivatePrevious
                Range("Q" & CStr(counter)).Select
                ActiveCell.Value = Combinedsand


      '   Copy initial frac gradient
                ActiveWindow.ActivateNext
                Sheets("Interval Summart").Select
                Worksheets("Design").Range("E64").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("V" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy final frac gradient
                ActiveWindow.ActivateNext
                Worksheets("Design").Range("H65").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("Y" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy ISIP
                ActiveWindow.ActivateNext
                Worksheets("Design").Range("E63").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("U" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

    '   Copy ISDP
                ActiveWindow.ActivateNext
                Worksheets("Design").Range("H64").Select
                Selection.Copy
                ActiveWindow.ActivatePrevious
                Range("X" & CStr(counter)).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False


End Sub

使用.Find方法，您需要先设置范围，然后才能选择范围

在你正在谈论的部分中，你应该改变

Set FindRow = Range("B:B").Find(What:="Date:", LookIn:=xlPart).Select

为此：

Set FindRow = Range("B:B").Find(What:="Date:", LookAt:=xlPart)
FindRow.Select

---

我这样做了，但仍然得到运行时错误91。对象变量或With block Variable not SET单击“调试”时，它将转到哪一行代码？它是否转到Set FindRow行？是的，它转到FindRow.select.inet工作簿中我试图从中提取它们的单元格被合并。我试着去拼凑它们，但并没有什么不同。你们能试着把一个模糊的FindRow作为范围，和其他变量声明放在一起吗？