Beste mensen,
Ik heb een code die als eerst alle namen van de sheets in een nieuwe sheet ("Samenvatting") neerzet.
Vervolgens haalt hij de waarden van bepaalde cellen uit dat sheet en zet deze bij de desbetreffende onderdeel neer.
Echter wil ik opbouw anders hebben. Zie voorbeeld.xlsx sheet "Samenvatting2".
alvast bedankt.
Met vriendelijke groet,
RoyBekijk bijlage voorbeeld.xlsx
Ik heb een code die als eerst alle namen van de sheets in een nieuwe sheet ("Samenvatting") neerzet.
Vervolgens haalt hij de waarden van bepaalde cellen uit dat sheet en zet deze bij de desbetreffende onderdeel neer.
Code:
Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Delete the sheet "Summary-Sheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("Samenvatting").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a worksheet with the name "Summary-Sheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "Samenvatting"
'The links to the first sheet will start in row 2
RwNum = 1
For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Copy the sheet name in the A column
Newsh.Cells(RwNum, 1).Value = Sh.Name
Newsh.Range("B1:G1").Value = Array("-1", "B-Bouwkunde", "W-Werktuigbouwkunde", "E-Elektrotechniek", "V-BHV / Beveiliging", "O-Overige")
Newsh.Range("I1:N1").Value = Array("0", "B-Bouwkunde", "W-Werktuigbouwkunde", "E-Elektrotechniek", "V-BHV / Beveiliging", "O-Overige")
Newsh.Range("P1:U1").Value = Array("1", "B-Bouwkunde", "W-Werktuigbouwkunde", "E-Elektrotechniek", "V-BHV / Beveiliging", "O-Overige")
Newsh.Range("W1:AB1").Value = Array("2", "B-Bouwkunde", "W-Werktuigbouwkunde", "E-Elektrotechniek", "V-BHV / Beveiliging", "O-Overige")
Newsh.Range("AD1:AI1").Value = Array("3", "B-Bouwkunde", "W-Werktuigbouwkunde", "E-Elektrotechniek", "V-BHV / Beveiliging", "O-Overige")
Newsh.Range("AK1:AP1").Value = Array("4", "B-Bouwkunde", "W-Werktuigbouwkunde", "E-Elektrotechniek", "V-BHV / Beveiliging", "O-Overige")
For Each myCell In Sh.Range("F23,F39,F49,F57,F65") '<--Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = 9
For Each myCell In Sh.Range("J23,J39,J49,J57,J65") '<--Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = 16
For Each myCell In Sh.Range("N23,N39,N49,N57,N65") '<--Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = 23
For Each myCell In Sh.Range("R23,R39,R49,R57,R65") '<--Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = 30
For Each myCell In Sh.Range("V23,V39,V49,V57,V65") '<--Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = 37
For Each myCell In Sh.Range("Z23,Z39,Z49,Z57,Z65") '<--Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
End If
Next Sh
Newsh.UsedRange.Columns.AutoFit
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Echter wil ik opbouw anders hebben. Zie voorbeeld.xlsx sheet "Samenvatting2".
alvast bedankt.
Met vriendelijke groet,
RoyBekijk bijlage voorbeeld.xlsx
Laatst bewerkt: