将100个diiferent excel工作簿中的数据合并到一个工作簿中
我正在尝试从多个Excel电子表格中提取某些数据。 我正在整理几百个类似Excel表格的数据。 我想写一个macros，这将允许我selectExcel电子表格，然后将从给定的variables名称拉所需的数据。
这是我的
公共小组CommandButton1_Click（）
“logging工作，模块化代码，多个客户。
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 从时间间隔摘要查找并复制date。
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
'searchA列中的第一个空白单元格。'当ActiveCell.Value <>“”counter = counter + 1 Range（“A”＆CStr（counter））。PasteSpecial xlPasteValuesAndNumberFormats Loop
将date粘贴到作业logging表上。 范围（“A”和CStr（计数器））。Select Selection.PasteSpecial Paste：= xlPasteValues，Operation：= xlNone，SkipBlanks _：= False，Transpose：= False Selection.UnMerge Selection.NumberFormat =“m / d / yyyy”
在工作logging表上logging以前的工程师姓名。 范围（“B”和CStr（计数器-1））。selectSelection.Copy范围（“B”和CStr（计数器））。selectSelection.PasteSpecial粘贴：= xlPasteValues，操作：= xlNone，SkipBlanks _：= False，移调：=假
“将客户名称复制到报表上。 selectCustomer = ActiveCell.Value Selection.Copy ActiveWindow.ActivatePrevious Range（“E”＆CStr（counter））。selectActiveSheet.Paste
'从devise粘贴到logging纸上。 ActiveWindow.ActivateNext如果客户=“Noble Energy Inc.” 工作表（“devise”）。范围（“O1”）。select其他工作表（“devise”）范围（“Q1”）。select结束如果Selection.Copy ActiveWindow.ActivatePrevious范围（“C”＆CStr（计数器） ）。selectActiveSheet.Paste Selection.UnMerge
Call Lease_Pad_Well_Copy(Customer, counter)
（“井数据”）查找和复制井数据的间隔＃设置FindRow = .Range（“B：B”）。Find（What：=“Date”，LookIn：= xlValues）Windows（“2014 GJ PE工程作业Logs.xls“）。激活范围（”A“＆CStr（计数器））。select结束
“复制中旬的深度报告表。
Worksheets("Actual").Range("C40").Select Selection.Copy ActiveWindow.ActivatePrevious Range("I" & CStr(counter)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
“将中间的深度TVD复制到报告单上。
Worksheets("Actual").Range("C40").Select Selection.Copy ActiveWindow.ActivatePrevious Range("I" & CStr(counter)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
“将顶部的深度复制到报告表。
Worksheets("Actual").Range("C40").Select Selection.Copy ActiveWindow.ActivatePrevious Range("I" & CStr(counter)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
“将底部的深度复制到报告表。
Worksheets("Actual").Range("C40").Select Selection.Copy ActiveWindow.ActivatePrevious Range("I" & CStr(counter)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
“将形成名称复制到报告表。 ActiveWindow.ActivateNext工作表（“devise”）。范围（“C3”）。selectSelection.Copy ActiveWindow.ActivatePrevious范围（“J”和CStr（计数器））。selectActiveSheet.Paste
'复制stream体系统。 selectSelection.Copy范围（“K”和CStr（counter））。selectSelection.PasteSpecial粘贴：= xlPasteValues，操作：= xlNone，SkipBlanks _：= False，移调：=假
“从以前的工作复制船员。 范围（“L”和CStr（counter-1））。selectSelection.Copy Range（“L”＆CStr（counter））。selectSelection.PasteSpecial Paste：= xlPasteValues，Operation：= xlNone，SkipBlanks _：= 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
'复制泥浆量
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
切换回并closuresdeviseActiveWindow.ActivateNext ActiveWorkbook.Save ActiveWindow.Close
Next vrtSelectedItem End If End With
“格式化作业日志条目。 ActiveWindow.ActivatePrevious Range（“A”＆CStr（counter-Designcounter）＆“：AE”＆CStr（counter））。selectApplication.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）） 。selectSelection.RowHeight = 13.5
结束小组
小组Lease_Pad_Well_Copy（客户，柜台）
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
结束小组
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
结束小组
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
结束小组
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
“复制总的性能打开。 ActiveWindow.ActivateNext工作表（“实际devise”）。范围（“E65”）。selectSelection.Copy ActiveWindow.ActivatePrevious范围（“W”和CStr（计数器））。selectselect。粘贴特殊粘贴：= xlPasteValues，操作：= 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
结束小组
这假设：
- 所有的床单都放在一本书里
- 工作表＃1将logging收集的数据
- 列A将包含工作表名称
- B列将包含收集的值
运行这个小macros：
Sub FindingDollarsSpent() Dim i As Long Dim l As Long l = 1 For i = 2 To Sheets.Count For Each r In Sheets(i).UsedRange If r.Value = "Dollars spent" Then With Sheets(1) .Cells(l, 1).Value = Sheets(i).Name .Cells(l, 2).Value = r.Offset(0, 1).Value End With l = l + 1 End If Next r Next i End Sub