HELP with macros

K

Karenderry11

Hi guys I was wondering if anyone could help. Im using a macro to submit
selected details into a table in a spreadsheet. The Macro submits the correct
details however each time I submit a new record it overwrites the existing
records as well i.e i end up with identical records all containing the
latest details submitted.
 
K

Karenderry11

Sub SubmitForm()
'
' SubmitForm Macro
' submits the contents of the form
'

'
' Add one to cell
Sheets("Sheet3").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
'Department
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C3").Select
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Module Code
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Module Title
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Day
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Period
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Length
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C29").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Room type
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D36").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'No. of rooms
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C42").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'No. of students
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C44").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Whiteboard
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D47").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Microphone
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D48").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Overhead
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D49").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Data
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D50").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Slide
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D51").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Disabled
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D52").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Special Reqs
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C54").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Area
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D60").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Priority Booking
Sheets("Sheet2").Select
Range("D62").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
'Border
ActiveCell.Offset(0, -18).Range("A1:S1").Select
ActiveCell.Activate
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(0, 0).Range("A1").Select
Sheets("Sheet1").Select
Range("E9").Select
End Sub
 
C

Chip Pearson

You should really clean that code up. It is almost never necessary to
Select anything. You can consolidate all your code to something like:


Sub AAA()
Dim Dest As Range ' Dest is the cell where the data
' is to be written
With Worksheets("YourDestinationWorksheetName")
' go to the blank row at the end of the existing data.
Set Dest = .Cells(.Rows.Count, "A").End(xlUp)(2, 1)
End With
With Dest.EntireRow
.Cells(1, "A").Value = 1 ' whatever goes in column A
.Cells(1, "B").Value = 2 ' whatever goes in column B
.Cells(1, "C").Value = 3 ' whatever goes in column C
' and so on
End With
End Sub

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)



Sub SubmitForm()
'
' SubmitForm Macro
' submits the contents of the form
'

'
' Add one to cell
Sheets("Sheet3").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
'Department
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C3").Select
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Module Code
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Module Title
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Day
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Period
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Length
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C29").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Room type
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D36").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'No. of rooms
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C42").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'No. of students
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C44").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Whiteboard
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D47").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Microphone
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D48").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Overhead
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D49").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Data
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D50").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Slide
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D51").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Disabled
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D52").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Special Reqs
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("C54").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Area
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Sheet2").Select
Range("D60").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveSheet.Paste
'Priority Booking
Sheets("Sheet2").Select
Range("D62").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
'Border
ActiveCell.Offset(0, -18).Range("A1:S1").Select
ActiveCell.Activate
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(0, 0).Range("A1").Select
Sheets("Sheet1").Select
Range("E9").Select
End Sub

Tim Williams said:
Code ?

Tim
Click to expand...
Click to expand...
 
Top