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.
Code:
Sub 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
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 please
Code:
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
