VBA code to transfer data from one worksheet to others using specific criteria

[lgetach]

hi,

I have been searching for a solution for some time now and hope that someone can help me!

i have a workbook that contains a number of sheets. sheet1 is titled "From" and is my data entry sheet. the other sheets are named with a contract number and an abbreviation of the contract type. ie: 0001-ABC, 0002-DEF etc.

I need a VBA code that can copy data (found at C8:CT9) from my data entry sheet and copy and paste special values only (to C60:CT61) any one of the other sheets based on what is stated in B1 of the data entry sheet. The person entring the data would choose from a driop down list the specific contract and enter the data into the data entry sheet. they would press a button and the data is transferred to the appropriate sheet.


i have found the code below:

Private Sub CommandButton1_Click()
Product$ = Right(Range("b1"), 5)
Range("C8:CT9").Copy
Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
' The following line shows how to reference a sheet within
' the loop using a simple text function
If Right$(ActiveWorkbook.Worksheets(I).Name, 5) = Product$ Then
Worksheets(I).Activate

End If
'Paste the data (values) in worksheet
ActiveSheet.Paste Destination:=Worksheets(I).Range("C60")

Next I
Application.CutCopyMode = False

End Sub

The problem with this code is the fact that it copies to all of the sheets but it will activate the sheet that is indicated in B1 and will take you uto that sheet. i need it to only paste to the specific sheet. Also, i need the code to paste special, values.

i hope someone can help me!

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Range("C8:CT9").Copy
    Sheets(Range("B1").Value).Range("C60").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
 End Sub

 

[dmt32]

Try this:

Private Sub CommandButton1_Click()
    On Error GoTo myerror
    With Worksheets("From")
        Worksheets(.Range("B1").Value).Range("C60:CT61").Value = _
        .Range("C8:CT9").Value
    End With
myerror:
    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

 

[lgetach]

thank you so much, this worked perfectly!

i have a follow up question

This data entry is ongoing and I would like to track the changes. is there a way to add to the code to ensure that the next time data is transferred to that sheet (or any of the other sheets), it will not simply replace what is in c60 but instead will find the next available row to paste to?

Also, what code do I use to clear the data entry sheet c8:ct9 field to ready it for the next data entry?

 

[mumps]

Hi Igetach. Try:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim bottomC As Long
    bottomC = Sheets(Range("B1").Value).Range("C" & Rows.Count).End(xlUp).Row
    If bottomC < 60 Then bottomC = 59
    Range("C8:CT9").Copy
    Sheets(Range("B1").Value).Range("C" & bottomC + 1).PasteSpecial xlPasteValues
    Range("C8:CT9").ClearContents
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
 End Sub

 

[lgetach]

wow! This is perfect, thank you so much for the quick response!

 

[mumps]

My pleasure.