Pulling data from another workbook and worksheet
i currently have the below VBA Script which is working fine. It is prompting me to open the first worksheet and the 2nd and adding the correct formulas into cells Z1 to AA6 on each sheet.
I need to add the below, which is currently excel formulas and can't work out how to do this without it all erroring. I have changed the name of the file to ws1 and ws2. Can anyone help pleaseSub InsertDataAndFormulas() Dim wb1 As Workbook Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim i As Integer 'Specify the path and name of the first workbook Dim firstWorkbookPath As String firstWorkbookPath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx") If firstWorkbookPath = "False" Then Exit Sub ' User canceled workbook selection End If 'Open the first workbook Set wb1 = Workbooks.Open(firstWorkbookPath) ' Loop through all worksheets in the first workbook For Each ws1 In wb1.Sheets ' Clear existing content in Z1:Z6 and AA1:AA6 ws1.Range("Z1:Z6").ClearContents ws1.Range("AA1:AA6").ClearContents ' Insert data into Z1:Z6 DataArray = Array("TOTAL PROPERTIES", "Hard Loc - OOS/ UEL / SED / UST", _ "Temp Loc - MISC /AUD / NOTDES / BME / RFB / PRRD / ADRD / BP /SEC58 / PIA", _ "Soft Loc - FCK / WAY / MDU", "RFS- ie BLANK/ SUR/ WSD/ DTL", "As Planned - (SF)") For i = 1 To 6 ws1.Cells(i, 26).Value = DataArray(i - 1) Next i ' Insert formulas into AA1:AA6 ws1.Cells(1, 27).Formula = "=COUNTIFS(A:A,""<>"")-1" ws1.Cells(2, 27).Formula = _ "=COUNTIF($Q:$Q,""*OOS*"")+COUNTIF($Q:$Q,""*UEL*"")+COUNTIF($Q:$Q,""*UST*"")+COUNTIF($Q:$Q,""*SED*"")" ws1.Cells(3, 27).Formula = "=SUM((AA1-(AA2+AA4+AA5)))" ws1.Cells(4, 27).Formula = "=COUNTIFS(C:C,""MDU"",Q:Q,""*way*"") + COUNTIFS(C:C,""<>*MDU*"",Q:Q,""*way*"") + COUNTIF(Q:Q,""fck"")" ws1.Cells(5, 27).Formula = "=COUNTIF(Q1:Q375,"""")+COUNTIF(Q:Q,""dtl"")+COUNTIF(Q:Q,""sur"")+COUNTIF(Q:Q,""wsd"")" ws1.Cells(6, 27).Formula = "=SUM(AA3:AA5)" Next ws1 ' Specify the path and name of the second workbook Dim secondWorkbookPath As String secondWorkbookPath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx") If secondWorkbookPath = "False" Then wb1.Close False ' User canceled second workbook selection, close the first workbook Exit Sub End If ' Open the second workbook Set wb2 = Workbooks.Open(secondWorkbookPath) ' Loop through all worksheets in the second workbook For Each ws2 In wb2.Sheets ' Clear existing content in Z1:Z6 and AA1:AA6 ws2.Range("Z1:Z6").ClearContents ws2.Range("AA1:AA6").ClearContents ' Insert data into Z1:Z6 For i = 1 To 6 ws2.Cells(i, 26).Value = DataArray(i - 1) Next i ' Insert formulas into AA1:AA6 ws2.Cells(1, 27).Formula = "=COUNTIFS(A:A,""<>"")-1" ws2.Cells(2, 27).Formula = "=COUNTIF($Q:$Q,""*OOS*"")+COUNTIF($Q:$Q,""*UEL*"")+COUNTIF($Q:$Q,""*UST*"")+COUNTIF($Q:$Q,""*SED*"")" ws2.Cells(3, 27).Formula = "=SUM((AA1-(AA2+AA4+AA5)))" ws2.Cells(4, 27).Formula = "=COUNTIFS(C:C,""MDU"",Q:Q,""*way*"") + COUNTIFS(C:C,""<>*MDU*"",Q:Q,""*way*"") + COUNTIF(Q:Q,""fck"")" ws2.Cells(5, 27).Formula = "=COUNTIF(Q1:Q375,"""")+COUNTIF(Q:Q,""dtl"")+COUNTIF(Q:Q,""sur"")+COUNTIF(Q:Q,""wsd"")" ws2.Cells(6, 27).Formula = "=SUM(AA3:AA5)" Next ws2 ' Save the workbooks (optional) ' wb1.Save ' wb2.Save ' Do not close the first workbook End Sub
Starting in ws.2 Y9 Original Release Sheet TOTAL PROPERTIES =ws1 AA1 Hard Loc - OOS/ UEL / SED / UST =ws1 AA2 Temp Loc - MISC /AUD / NOTDES / BME / RFB / PRRD / ADRD / BP /SEC58 / PIA =ws1 AA3 Soft Loc - FCK / WAY / MDU =ws1 AA4 RFS- ie BLANK/ SUR/ WSD/ DTL =ws1 AA5 As Planned - (SF) =ws1 AA6 Difference Hard Loc - OOS/ UEL / SED / UST =AA10-AA2 Temp Loc - MISC /AUD / NOTDES / BME / RFB / PRRD / ADRD / BP /SEC58 / PIA =AA11-AA3 Soft Loc - FCK / WAY / MDU =AA12-AA4 RFS- ie BLANK/ SUR/ WSD/ DTL =AA13-AA5 As Planned - (SF) =AA14-AA6 Difference in RFS =AA14-AA6
Reply With Quote
