Related
I currently have code set up that will loop through all the worksheets in my workbook, paste a date in a cell which, when non blank, will have the remaining cells in the row populate with data.
At the beginning of each row - I have a formula that will say "Error" if any of the cells in that row has an error in it. like this:
I then have another loop which will go back through each worksheet and check to see if there is an error in that cell and if so, will go to the first sheet in the workbook to a specific cell and add "Error on xyz Tab". If there are multiple errors, it'll go to the next row down and paste it. So it looks like this:
I'm thinking instead of looping through each sheet again, could i store the text string in a variable/array and just paste it on the front sheet at the end of the loop in the same manner?
This is the code for the error loop that's currently set up:
For I = 1 To WS_Count
ActiveWorkbook.Worksheets(I).Activate
Cells.Find(What:="Date", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).End(xlDown).Offset(0, -1).Activate
If ActiveCell.Value = "Error" Then
Application.Goto "ErrorCheck"
If ActiveCell.Offset(1, 0).Value = vbNullString Then
ActiveCell.Offset(1, 0).Value = "Error on " & ActiveWorkbook.Worksheets(I).Name & " " & Hour(Now) & "00"
Else
Selection.End(xlDown).Activate
ActiveCell.Offset(1, 0).Value = "Error on " & ActiveWorkbook.Worksheets(I).Name & " " & Hour(Now) & "00"
End If
Else
End If
Next I
So with this I personally wouldn't want to use an array. I would prefer using a collection. It is easier because you do not know the parameters for your array so it is tough to give it dimensions.
Nonetheless find below a possible solution. Work it to your needs. I have yet to test or debug myself. But should do the trick.
Sub ErrorCheck()
Dim x As Long, lRow1 As Long, lRow2 As Long
Dim myCollection As New Collection
Dim ws As Worksheet
Dim mySheet As Worksheet
Set mySheet = Sheets("ErrorCheckSheet")
'create the for loop to cycle through worksheets
For Each ws In ThisWorkbook.Worksheets
'set the lrow to iterate through column
'set the colum for your need - "Error" column
lRow1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
'IF lRow does not match your cell, use a static variable ie. 50
'assuming your data starts in row 2 as per picture
For x = 2 To lRow1
'check each cell for error text
If ws.Range("A" & x).Text = "Error" Then
'when found add to collection
'adjust to meet your cell you want to input into collection
myCollection.Add ws.Range("B" & x).Text
End If
Next x
Next ws
'once you have completely cycled through your workbook your collection will now be loaded
For x = 1 To myCollection.Count
'set the lrow on the sheet you want to enter the data in
lRow2 = mySheet.Range("U" & mySheet.Rows.Count).End(xlUp).Row + 1
'now set the variable
mySheet.Range("U" & lRow2).Value = "Error on" & myCollection(x)
Next x
Set myCollection = New Collection
Set mySheet = Nothing
End Sub
I have working code that creates a PDF file that I have put together from answers here (much appreciated!) and elsewhere but there are 2 parts missing:
the ability to add other print areas not defined in a sheet.
the ability to use checkboxes on a master sheet to select which sheet to PDF
The established / set print areas on each sheet need to remain for normal printing.
The code below works for the array defined sheets (the sheets have print ranges set):
I currently set the array of sheets
I create the file name based on the workbook
I make the directory the same as the workbook
I then use a windows standard save as dialog box with the ability to cancel (code gracefully exits)
I have error coding just in case.
I appreciate your help!
Sub SaveSheetsAsPDF_Lender()
Dim wksAllSheets As Variant
Dim wksSheet1 As Worksheet
Dim strFilename As String, strFilepath As String
On Error GoTo errHandler
Set wksSheet1 = ThisWorkbook.ActiveSheet 'ActiveSheet 'ThisWorkbook.Sheets("rsrvs")
wksAllSheets = Array("initial", "apt", "rsrvs", "proj", "bond2", "refi", "amort2", "su2", "sum2")
strFilepath = Application.ActiveWorkbook.Path
With wksSheet1
strFilename = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) 'remove the excel EXTENSION to add PDF
strFilename = strFilepath & "\" & strFilename & ".pdf"
End With
With Excel.Application.FileDialog(msoFileDialogSaveAs)
Dim i As Integer
For i = 1 To .Filters.Count
If InStr(.Filters(i).Extensions, "pdf") <> 0 Then Exit For
Next i
.FilterIndex = i
.InitialFileName = strFilename
.Title = "Select Folder and File Name to save"
If CBool(.Show) Then
strFilename = .SelectedItems.Item(.SelectedItems.Count)
Else
MsgBox "You cancelled the SAVE. A PDF file was NOT created.", vbExclamation, "PDF NOT Created."
Exit Sub
End If
ThisWorkbook.Sheets(wksAllSheets).Select 'select tabs to save.
If strFilename <> "False" Then
wksSheet1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True ' **IF** OpenAfterPublish:=FALSE then activate msgbox
'' **IF** OpenAfterPublish:=FALSE then activate msgbox
End If
wksSheet1.Select 'Make sure all the worksheets are NOT left selected
End With 'part of the overwrite code above
exitHandler:
Exit Sub
errHandler:
wksSheet1.Select 'Make sure all the worksheets are NOT left selected
MsgBox "Could not create PDF file" & vbCrLf & "Contact Marc ASAP."
Resume exitHandler
wksSheet1.Select 'Make sure all the worksheets are NOT left selected
End Sub
I'm currently using the following code to reset an event/inventory/sales workbook. However, I was hoping to find a way to have the user select (via dialog sheet or userform with checkboxes) which sheets need to be reset. As it is right now, when the "Create New Event" button is clicked, every sheet in the sNames array is reset, but I would like for a dialog sheet or userform to popup which would allow the user to choose which sheets would be reset (aka... which ones that array would contain). So the sheets being reset would not be fixed and/or could be different each time the "Create new event" macro is run. In other words, the remaining code would stay the same, only the sheets included in the sNames array would change.
The full code that I have right now is as follows (Please note that this currently works, but the sheets being reset are fixed and/or are always the same)
Option Explicit
Sub Create_NewEvent()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const BESTNFL As String = DBLSPACE & vbNewLine & _
"The Baltimore Ravens Rule!" & _
"The Forty-Winers Do NOT"
Const openMSG As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on whether or not the Ravens have a winning record," & _
"and whether or not..." & DBLSPACE & _
"Just be patient! Root for the Ravens and...!" & BESTNFL
Dim w As Long, I As Long, x As Long, sNames As Variant, invNames As Variant, colm As Range, tbl As Range, col1 As Range, invRng As Range
Dim wb As Workbook, ws As Worksheet, fbDate As Variant, fbEvent As Variant
Set wb = ThisWorkbook
'************************************IF YOU ADD A NEW STAND SHEET, PLEASE ADD THE SHEET NAME THIS ARRAY*********************************************************
sNames = Array(Sheet1, Sheet3, Sheet5, Sheet7, Sheet9, Sheet13, _
Sheet17, Sheet21, Sheet23, Sheet27, Sheet31, Sheet35, _
Sheet39, Sheet43, Sheet47, Sheet54, Sheet56, _
Sheet58, Sheet60, Sheet61, Sheet62, Sheet63, Sheet64, _
Sheet65, Sheet82, Sheet83, Sheet84, Sheet85, Sheet90, _
Sheet91, Sheet93, Sheet94)
'***************************************************************************************************************************************************************
'*************************IF YOU ADD A NEW NPO INVOICE, PLEASE ADD THE SHEET NAME & NUMBER IN THIS ARRAY********************************************************
invNames = Array(Sheet2, Sheet4, Sheet6, Sheet8, Sheet11, Sheet15, Sheet19, Sheet25, Sheet29, Sheet33, Sheet37, _
Sheet41, Sheet45, Sheet52, Sheet53, Sheet55, Sheet66, Sheet87)
'***************************************************************************************************************************************************************
If MsgBox("Are you sure that you want to create a new event?", vbYesNo, "Confirm") = vbYes Then
MsgBox openMSG
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For w = LBound(sNames) To UBound(sNames)
With sNames(w)
Debug.Print .Name
.Range("D7:D38") = .Range("M7:M38").Value
Set tbl = .Range("B6:P38"): Set colm = .Range("M4")
ActiveWorkbook.Names.Add Name:="sTable", RefersTo:=tbl
ActiveWorkbook.Names.Add Name:="col", RefersTo:=colm
.Range("E7").Formula = "=IFERROR(IF(VLOOKUP(B7,sTable,3,FALSE)>=VLOOKUP(B7,parTable,col,FALSE),0,ROUND(SUM((VLOOKUP(B7,parTable,col,FALSE)-VLOOKUP(B7,sTable,3,FALSE))/VLOOKUP(B7,parTable,4,FALSE)),0)*VLOOKUP(B7,parTable,4,FALSE)),0)"
.Range("E7").Copy
.Range("E8:E38").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
.Range("E7:E38").Copy
.Range("E7:E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
.Range("G7:M38,P43:P45").ClearContents
ActiveWorkbook.Names("sTable").Delete
ActiveWorkbook.Names("col").Delete
Set tbl = Nothing: Set col1 = Nothing
End With
Next w
For I = LBound(invNames) To UBound(invNames)
With invNames(I)
Debug.Print .Name
Set invRng = .Range("B56:I56")
.Range("E55").Value = 0
For x = 1 To invRng.Cells.Count
invRng.Cells(x) = ""
Next x
Set invRng = Nothing
End With
Next I
fbDate = InputBox("Please enter the new event date in the format of 2/3/2013. This will be inserted onto the standsheets. And by the way... 2/3/2013 happens to be a past superbowl. Can you guess which one?")
fbEvent = InputBox("Please Enter the new event name. This will be inserted into the cell provided for Event Name")
Sheet49.Range("B3").Value = fbDate
Sheet49.Range("B4").Value = fbEvent
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Your new event has been created...
End If
End Sub
Nevermind everyone.... Through a few hours of trial & error, I was able to get the following code to work perfectly... Not sure if I did this correctly (syntax, best practices, etc...), but it is definitely working exactly how I wanted it to...
Option Explicit
Sub Create_NewEvent()
Const DBLSPACE As String = vbNewLine & vbNewLine
Const BESTNFL As String = DBLSPACE & vbNewLine & _
"The Baltimore Ravens Rule!" & _
"The Forty-Winers Do NOT"
Const openMSG As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on whether or not the Ravens have a winning record," & _
"and whether or not..." & DBLSPACE & _
"Just be patient! Root for the Ravens and...!" & BESTNFL
Dim tPos As Integer, cb As CheckBox, SheetCount As Integer, sDlg As DialogSheet
Dim w As Long, I As Long, y As Variant, x As Long, z As Long, sNames As Variant, invNames As Variant, colm As Range, tbl As Range, col1 As Range, invRng As Range
Dim wb As Workbook, ws As Worksheet, fbDate As Variant, fbEvent As Variant
Set wb = ThisWorkbook
'************************************IF YOU ADD A NEW STAND SHEET, PLEASE ADD THE SHEET NAME THIS ARRAY*********************************************************
sNames = Array(Sheet1, Sheet3, Sheet5, Sheet7, Sheet9, Sheet13, _
Sheet17, Sheet21, Sheet23, Sheet27, Sheet31, Sheet35, _
Sheet39, Sheet43, Sheet47, Sheet54, Sheet56, _
Sheet58, Sheet60, Sheet61, Sheet62, Sheet63, Sheet64, _
Sheet65, Sheet82, Sheet83, Sheet84, Sheet85, Sheet90, _
Sheet91, Sheet93, Sheet94)
'***************************************************************************************************************************************************************
'*************************IF YOU ADD A NEW NPO INVOICE, PLEASE ADD THE SHEET NAME & NUMBER IN THIS ARRAY********************************************************
invNames = Array(Sheet2, Sheet4, Sheet6, Sheet8, Sheet11, Sheet15, Sheet19, Sheet25, Sheet29, Sheet33, Sheet37, _
Sheet41, Sheet45, Sheet52, Sheet53, Sheet55, Sheet66, Sheet87)
'***************************************************************************************************************************************************************
If MsgBox("Are you sure that you want to create a new event?", vbYesNo, "Confirm") = vbYes Then
MsgBox openMSG
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set sDlg = ActiveWorkbook.DialogSheets.Add
SheetCount = 0
tPos = 40
For z = LBound(sNames) To UBound(sNames)
Set ws = sNames(z)
If Application.CountA(ws.Cells) <> 0 Then
SheetCount = SheetCount + 1
sDlg.CheckBoxes.Add 78, tPos, 150, 16.5
sDlg.CheckBoxes(SheetCount).Text = _
ws.Name
tPos = tPos + 13
End If
Set ws = Nothing
Next z
sDlg.Buttons.Left = 240
With sDlg.DialogFrame
.Height = Application.Max _
(68, sDlg.DialogFrame.Top + tPos - 34)
.Width = 230
.Caption = "Select Stands to Open"
End With
sDlg.Buttons("Button 2").BringToFront
sDlg.Buttons("Button 3").BringToFront
If SheetCount <> 0 Then
If sDlg.Show Then
For Each cb In sDlg.CheckBoxes
If cb.Value = xlOn Then
y = cb.Caption
With Sheets(y)
Debug.Print .Name
.Range("D7:D38") = .Range("M7:M38").Value
Set tbl = .Range("B6:P38"): Set colm = .Range("M4")
wb.Names.Add Name:="sTable", RefersTo:=tbl
wb.Names.Add Name:="col", RefersTo:=colm
.Range("E7").Formula = "=IFERROR(IF(VLOOKUP(B7,sTable,3,FALSE)>=VLOOKUP(B7,parTable,col,FALSE),0,ROUND(SUM((VLOOKUP(B7,parTable,col,FALSE)-VLOOKUP(B7,sTable,3,FALSE))/VLOOKUP(B7,parTable,4,FALSE)),0)*VLOOKUP(B7,parTable,4,FALSE)),0)"
.Range("E7").Copy
.Range("E8:E38").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
.Range("E7:E38").Copy
.Range("E7:E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
.Range("G7:M38,P43:P45").ClearContents
wb.Names("sTable").Delete
wb.Names("col").Delete
Set tbl = Nothing: Set col1 = Nothing
End With
End If
Next cb
End If
Else
MsgBox "All worksheets are empty."
End If
sDlg.Delete
For I = LBound(invNames) To UBound(invNames)
With invNames(I)
Debug.Print .Name
Set invRng = .Range("B56:I56")
.Range("E55").Value = 0
For x = 1 To invRng.Cells.Count
invRng.Cells(x) = ""
Next x
Set invRng = Nothing
End With
Next I
fbDate = InputBox("Please enter the new event date in the format of 2/3/2013. This will be inserted onto the standsheets. And by the way... 2/3/2013 happens to be a past superbowl. Can you guess which one?")
fbEvent = InputBox("Please Enter the new event name. This will be inserted into the cell provided for Event Name")
Sheet49.Range("B3").Value = fbDate
Sheet49.Range("B4").Value = fbEvent
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Your new event has been created... Don't mess anything up today Mark! The Baltimore Ravens rule!!"
End If
End Sub
I am trying to loop through an array of specific worksheets via VBA, but keep getting errors. I've been at this for over a week now, and finally have brought myself to signup here. The code that I currently have is as follows:
Option Explicit
Sub Create_NewEvent2()
Dim i As Variant, wName As Variant, x As Variant, ws As Worksheet
wName = Array("Sheet1", "Sheet3", "Sheet5", "Sheet7", "Sheet9", _
"Sheet13", "Sheet17", "Sheet21", "Sheet23", "Sheet27", "Sheet31", _
"Sheet35", "Sheet39", "Sheet43", "Sheet47", "Sheet54", _
"Sheet56", "Sheet57", "Sheet58", "Sheet60", "Sheet61", "Sheet62", _
"Sheet63", "Sheet64", "Sheet65", "Sheet82", "Sheet83", "Sheet84", _
"Sheet85", "Sheet90", "Sheet91", "Sheet93", "Sheet94")
For Each ws In ActiveWorkbook.Worksheets
For i = LBound(wName) To UBound(wName)
If ws.CodeName = wName(i) Then
ws.Visible = xlSheetVisible
ws.Range("M7:M38").Select
Selection.Copy
ws.Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ws.Range("G7:M38,E7:E38,P43:P45").Select
ws.Range("P43").Activate
Selection.ClearContents
ws.Visible = xlSheetVeryHidden
Call AutoStock
End If
Next i
Next ws
End Sub
The error message that I got from this last piece of code is "Select Method of Range Class Failed." When I debug, it has the "ws.Range("M7:M38").Select" highlighted, but I've used this exact syntax in other pieces and worked just fine. Can anyone tell me where I've went wrong with this? Any help will be greatly appreciated..
See revised code with small modifications and comments.
I suggest not to use ActiveWorkbook as not necessarily is the one that you want to work with is active. Also there is no need to select the ranges you are working to (comments and documentation referred by #Jeeped)
Sub Create_NewEvent2_New()
Dim wName As Variant, vName As Variant
wName = Array("Sheet1", "Sheet3", "Sheet5", "Sheet7", "Sheet9", _
"Sheet13", "Sheet17", "Sheet21", "Sheet23", "Sheet27", "Sheet31", _
"Sheet35", "Sheet39", "Sheet43", "Sheet47", "Sheet54", _
"Sheet56", "Sheet57", "Sheet58", "Sheet60", "Sheet61", "Sheet62", _
"Sheet63", "Sheet64", "Sheet65", "Sheet82", "Sheet83", "Sheet84", _
"Sheet85", "Sheet90", "Sheet91", "Sheet93", "Sheet94")
Dim Wbk As Workbook 'Set workbook variable don't use ActiveWorkbook
Dim ws As Worksheet
Rem Set Workbook - Change as needed if applied to another workbook.
Set Wbk = ThisWorkbook
Rem Loop thru List of Worksheets instead of All Worksheets
For Each vName In wName
Set ws = Nothing
On Error Resume Next
Set ws = Wbk.Worksheets(vName)
On Error GoTo 0
If Not (ws Is Nothing) Then
With ws
.Visible = xlSheetVisible
.Range("M7:M38").Copy
.Range("D7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Range("G7:M38,E7:E38,P43:P45").ClearContents
.Visible = xlSheetVeryHidden
End With
Call AutoStock
End If: Next
End Sub
The Worksheet.CodeName actually returns a Worksheet object. You can construct your array with them directly.
Sub Create_NewEvent2()
Dim w As Long, vCODENAMEs As Variant
vCODENAMEs = Array(Sheet1, Sheet3, Sheet5, Sheet7, Sheet9, Sheet13, _
Sheet17, Sheet21, Sheet23, Sheet27, Sheet31, Sheet35, _
Sheet39, Sheet43, Sheet47, Sheet54, Sheet56, Sheet57, _
Sheet58, Sheet60, Sheet61, Sheet62, Sheet63, Sheet64, _
Sheet65, Sheet82, Sheet83, Sheet84, Sheet85, Sheet90, _
Sheet91, Sheet93, Sheet94)
For w = LBound(vCODENAMEs) To UBound(vCODENAMEs)
With vCODENAMEs(w)
Debug.Print .Name 'string name of the worksheet
' all of your other operations here
'.Visible = xlSheetVisible 'you do not have to unhide for the operations you've chosen if you reference directly
.Range("D7:D38") = .Range("M7:M38").Value
.Range("E7:E38,G7:M38,P43:P45").ClearContents
.Visible = xlSheetVeryHidden
Call AutoStock
End With
Next w
End Sub
With direct worksheet and cell referencing, I've completely avoided all of the .Activate and .Select nonsense. See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Select does not work on a worksheet that is not active.
Call ws.Activate first and then Select should work.
What I am trying to do is this.
I have a customer information form, with information stored on the 1st sheet in two columns, the range is F5:F38,M5:M33
I have an empty database on worksheet2 that i'd like to populate with this data, Starting on C5 across to BM5
I want to be able to assign the macro to an 'add' button, and have the macro automatically insert a new row for the data and copy it across, enabling users to use worksheet1 to populate!
Matt
Updated from David's advice thus far. The only outstanding issue is that when running the script, Column M has the marching ants but the data itself does not copy across. For further clarity, the sheet has data validation and some conditional formatting (a few drop-down options and some colour coding on Y/N answers), i'm not sure if this is a factor.
Dim wsDB As Worksheet
Dim wsInfo As Worksheet
Sub Main()
Set wsDB = Worksheets("DATABASE")
Set wsInfo = Worksheets("INPUT")
insertnewrow
addcolumnf
addcolumnm
End Sub
Sub insertnewrow()
'
' insertnewrow Macro
wsDB.Rows("6:6").Insert _
Shift:=xlDown, _
CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub addcolumnf()
'
' addcolumnf Macro
wsInfo.Range("F5:F38").Copy
wsDB.Range("C6:AJ6").PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
Sub addcolumnm()
'
' addcolumnm Macro
'
Application.CutCopyMode = False
wsInfo.Range("M5:M33").Copy
wsDB.Range("AK6:BM6").PasteSpecial _
Paste:=xlAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End Sub
OK. I am not exactly sure what your problem is but likely related to unqualified object variables. When you do something like:
Range("A1").Select
Excel always interprets that as belonging to the ActiveSheet object. Since you are relying on the Selection method, it becomes difficult to track what is happening, you need to constantly select new objects to scope everything properly, etc.
This can be avoided by revising your code to something like:
Dim wsDB As Worksheet
Dim wsInfo As Worksheet
Sub Main()
Set wsDB = Worksheets("Database")
Set wsInfo = Worksheets("Sheet3") 'MODIFY AS NEEDED
insertnewrow
addcolumnf
addcolumnm
End Sub
Sub insertnewrow()
'
' insertnewrow Macro
wsDB.Rows("6:6").Insert _
Shift:=xlDown, _
CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub addcolumnf()
'
' addcolumnf Macro
wsInfo.Range("F5:F38").Copy
wsDB.Range("C6:AJ6").PasteSpecial _
Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
Sub addcolumnm()
'
' addcolumnm Macro
'
Application.CutCopyMode = False
wsInfo.Range("M5:M33").Copy
wsDB.Range("AK6:BM6").PasteSpecial _
Paste:=xlAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
End Sub
After I run this a few times, my "Database" worksheet looks like the image below. Simply call the Main routine which fires the other three. It will always insert a blank row in row 6, and it will always copy columns F and M in to that new row.
I suggest you get started with a tool included in Microsoft Excel called "Data Form". Add it into the menu and use it. An important thing is that you need reorganize your data: In the first line put the header (e.g begin in A1 to A...) and data in next lines. This organzation will help you to exploit your information using Pivot tables.
If you prefer use a button to call the form, you can use this macro assigned to a button:
Sub Macro1()
Sheets("worksheet1").Select
Range("A1").Select
ActiveSheet.ShowDataForm
End Sub
This link will show you more about that tool:
http://www.homeandlearn.co.uk/excel2007/excel2007s8p1.html
If you have knowledge of programming I could show you how to do what you want using VBA in Excel (for, while, etc). It is a little more complicated.
Here the code that you need. but is necesary that C5 in sheet2 is nt empty:
Sub Macro6()
Dim Count As Long
'Copy first column
Sheets("worksheet1").Select
Range("F5:F38").Select
Selection.Copy
'Search the next row empty
Sheets("worksheet2").Select
Range("C5").Select
Selection.End(xlDown).Select
Count = ActiveCell.Cells.Row + 1
'Copy in the next empty row
Range("C" & Count).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'Again with the next column
'Copy second column
Sheets("worksheet1").Select
Range("M5:M33").Select
Application.CutCopyMode = False
Selection.Copy
'Copy in the same row in the second sheet
Sheets("worksheet2").Select
Range("AK" & Count).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub