Hi all,
Im new to this so please bare with me :P !! i have only started using macros recently so not good at it at all. here is the story i have around 30 something worksheets all with the same format and i am interested in 2 columns from each worksheet. one column contains numbers of observations for different headings and the other column contains a description of each observation.
what i am trying to do is copy the number column from each of my 30ish worksheets and plot them into one summary sheet beside each other which i have managed to do as shown in the code below, the second thing i want to do is insert my observation column as a comment for each of the corresponding cells in the summary sheet. i have being trying to do it but no luck . if any one can lead me in the right path or maybe come up with a better alternative that would be very helpful thanks.
the code i have so far:
Sub HoneyBoo()
' introduces variales
Dim Sht As Worksheet
Dim ShtName As String
' Deletes previous content in summary page
Sheets("Summary").Select
Cells.Select
Selection.Delete Shift:=xlUp
' pastes in the headings
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("B1 Canteen").Select
Range("A8:G33").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Summary").Select
Range("A1").Select
ActiveSheet.Paste
' loop for pasting the values in
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Summary" Then
Sht.Select
ShtName = ActiveSheet.Name
Range("H9:H33").Select
Selection.Copy
Sheets("Summary").Select
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveCell.Value = ShtName
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Else
End If
Next Sht
' inserting a blank rows & coloumn
Sheets("Summary").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").ColumnWidth = 3.5
Range("I32").Select
'making the headings Bold
Range("I2").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
' autofitin the coloumns
Columns("I:CW").Select
Columns("I:CW").EntireColumn.AutoFit
Range("A1").Select
End Sub
Im new to this so please bare with me :P !! i have only started using macros recently so not good at it at all. here is the story i have around 30 something worksheets all with the same format and i am interested in 2 columns from each worksheet. one column contains numbers of observations for different headings and the other column contains a description of each observation.
what i am trying to do is copy the number column from each of my 30ish worksheets and plot them into one summary sheet beside each other which i have managed to do as shown in the code below, the second thing i want to do is insert my observation column as a comment for each of the corresponding cells in the summary sheet. i have being trying to do it but no luck . if any one can lead me in the right path or maybe come up with a better alternative that would be very helpful thanks.
the code i have so far:
Sub HoneyBoo()
' introduces variales
Dim Sht As Worksheet
Dim ShtName As String
' Deletes previous content in summary page
Sheets("Summary").Select
Cells.Select
Selection.Delete Shift:=xlUp
' pastes in the headings
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("B1 Canteen").Select
Range("A8:G33").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Summary").Select
Range("A1").Select
ActiveSheet.Paste
' loop for pasting the values in
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Summary" Then
Sht.Select
ShtName = ActiveSheet.Name
Range("H9:H33").Select
Selection.Copy
Sheets("Summary").Select
Range("IV1").End(xlToLeft).Offset(0, 1).Select
ActiveCell.Value = ShtName
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Else
End If
Next Sht
' inserting a blank rows & coloumn
Sheets("Summary").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").ColumnWidth = 3.5
Range("I32").Select
'making the headings Bold
Range("I2").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
' autofitin the coloumns
Columns("I:CW").Select
Columns("I:CW").EntireColumn.AutoFit
Range("A1").Select
End Sub