Home Pulling data from 100s of diiferent excel Workbooks into one workbook
Reply: 0

Pulling data from 100s of diiferent excel Workbooks into one workbook

user21214
1#
user21214 Published in July 21, 2018, 11:29 am

I am trying to pull certain data from multiple excel spreadsheets. I am trying to consolidate data from literally 100s of similar excel sheets. I want to write a Macro that will allow me to select the excel spreadsheets then will pull the desired data from a given variable name.

This is what I have

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
Dim FindRow As Range




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.

                Set FindRow = Cells.Find(What:="Date:", LookAt:=xlPart)
                FindRow.Select
                ActiveCell.Offset(0, 3).Select
                Selection.Copy

            Windows("2014 GJ PE Engineering Job Logs - Iteration 2.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 = "Williams Prod RMT" Or Customer = "Chevron" Then
    Call Copy_Williams_Data(Customer, counter)
End If

If Customer = "Noble Energy Inc." Then
    Call Copy_Noble_Data(Customer, counter)
End If

If Customer = "Bill Barrett Corp." Then
    Call Copy_BBC(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 = "Williams Prod RMT" Or Customer = "Chevron" Or Customer = "Noble Energy Inc." Or Customer = "Bill Barrett Corp." 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 = "Bill Barrett Corp." 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_Noble_Data(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

You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.316524 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO