Need help on Macro

[caprioftoday2000]

Hi All,

I am working on an QA audit sheet, need help on creating a macro which will pick data from sheet 1 and paste this to a new row master row.

I have coded Macro...but it is pasting on the same row on Master sheet....not going to new row.

pls help.

Regards

 

[VoG]

Try posting your code.

 

[caprioftoday2000]

Sub Copy_data()
'
' Copy_data Macro
' Copies the data.
'
' Keyboard Shortcut: Ctrl+p
'

ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 10
Range("W3:W32").Select
Selection.Copy
Sheets("Master Database").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
Sheets("Audit Sheet").Select
ActiveWindow.LargeScroll ToRight:=-1
ActiveWindow.SmallScroll Down:=-15
Range("C5").Select

End Sub

 

[VoG]

Try

Sub Copy_data()
'
' Copy_data Macro
' Copies the data.
'
' Keyboard Shortcut: Ctrl+p
'

Range("W3:W32").Copy
Sheets("Master Database").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub

 

[caprioftoday2000]

Wow...works, thanks buddy!!!

 

[caprioftoday2000]

Also can i put some validation that till all the parameters are marked and all the information is filled, submit button is not active? Or may be gives some error mesage "Pls fill all the required information before clicking on Submit button"

 

[VoG]

Try

Sub Copy_data()
'
' Copy_data Macro
' Copies the data.
'
' Keyboard Shortcut: Ctrl+p
'
If WorksheetFunction.CountA(Range("W3:W32")) <> 30 Then
    MsgBox "Please complete the information first", vbInformation
    Exit Sub
End If
Range("W3:W32").Copy
Sheets("Master Database").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub

 

[caprioftoday2000]

It is picking up blanks as well...for eg : even if i leave a parameter value bank after i click "Submit", there is no msg that appears and copies the information.

Pls help.

Try

Sub Copy_data()
'
' Copy_data Macro
' Copies the data.
'
' Keyboard Shortcut: Ctrl+p
'
If WorksheetFunction.CountA(Range("W3:W32")) <> 30 Then
    MsgBox "Please complete the information first", vbInformation
    Exit Sub
End If
Range("W3:W32").Copy
Sheets("Master Database").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub

 

[VoG]

If I leave any cells in the range blank I get a message. Make sure that they are blank and do not contain spaces.

 

[caprioftoday2000]

Is there any difference in the code pasted previously and the one that you pasted just now? I think both of them are exactly the same.

Thnx