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

Question

这就是我现在正在使用的内容。我正在尝试更改此宏以查找特定值/文本并将该数据复制到数据挖掘工作簿。

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

我认为如果我能弄清楚如何使它适用于“从间隔摘要中查找和复制日期。”，那么我可以使用该方法来更改宏的其他部分。该部分有我目前的尝试使这个宏工作，但我一直在收到错误。

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

Answer 1

使用.Find方法，您需要先设置范围.Select。

在您正在讨论的部分中，您应该更改

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

到此：

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