PDA

View Full Version : Need Macro to paste to the next free line



joshgray93
08-26-2015, 07:18 AM
Hi,

I have created a macro to paste selected cells on a data input form to another worksheet (the Feedback storage worksheet) - it does this successfully however it overwrites the existing data and I need it to paste to the next free row. This is my first time using VBA so please help!


Sub Work()'
' Work Macro
'


'
Range("D6").Select
Selection.Copy
Sheets("Feedback Worksheet").Select
Range("A1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Data Input").Select
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feedback Worksheet").Select
Range("B2").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Data Input").Select
Range("D10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feedback Worksheet").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Data Input").Select
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feedback Worksheet").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Data Input").Select
Range("D14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feedback Worksheet").Select
Range("E2").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Data Input").Select
Range("D16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feedback Worksheet").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
Sheets("Data Input").Select
Range("D18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feedback Worksheet").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveWindow.LargeScroll ToRight:=-1
ActiveCell.Offset(1, -7).Range("A1").Select
Sheets("Data Input").Select
Range("D18").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D16").Select
Selection.ClearContents
Range("D14").Select
Selection.ClearContents
Range("D12").Select
Selection.ClearContents
Range("D10").Select
Selection.ClearContents
Range("D8").Select
Selection.ClearContents
Range("D6").Select
Selection.ClearContents
End Sub





Can anybody help me please?

Thank you

Josh