MACROS - Copy row from sheet to sheet.

O

OfficeMan

Good Morning!

I need some help.

I have this workbook with a total of 8 sheets.

The main sheet is called “TRANSFERSâ€
The other 8 are the named “ERROR1†“ERROR2â€â€ERROR3†and so on…

On the main sheet I have this columns

A B C D E F G
Name Date Sup Lead Manager Number Error

What I need is each time a row in filled on the main sheet; I would like it
to be copied to each sheet according to the error.

The error will be entered on ROW G whether is an error1 or error 2, I want
the row to remain on the MAIN sheet but a copy to be moved to each sheet
according to the error.

Can this be possible? I have been trying but just can make Macros work.

Any help would be appreciated. Thank you
 
M

Mike H

Hi,

I've assigned this to the Double Click event. You enter data into your sheet
then double click the cell in column g and the data are copied to their
respective sheets.

Right click the sheet tab on 'Transfers' view code and paste this in. Note
there'e a commented out line that will clear the data from the maion sheet if
that's what you want.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
If Target.Column <> 7 Then Exit Sub
Select Case UCase(Target.Value)
Case Is = "ERROR 1"
Set myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "ERROR 2"
Set myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "ERROR 3"
Set myrange = Target.Offset(0, -6).Resize(1, 7)
End Select
If Not myrange Is Nothing Then
lastrow = Sheets(Target.Value).Cells(Rows.Count, "A").End(xlUp).Row
myrange.Copy Destination:=Sheets(Target.Value).Range("A" & lastrow + 1)
'myrange.ClearContents
End If
End Sub

Mike
 
O

OfficeMan

Thanks for the help!

I pasted this and it gives me an error of "Object Required" and it
highlights this line

If Not Myrange Is Nothing Then

Is there a way to have the row coppied to the sheet it corresponds
automatically in other words, if column G receives an ipunt of ERROR2 that
would triger the row to be copied?

I do not need the row to be deleted so I deleted the commented outline -

thanks again.
 
M

Mike H

That was caused by my sloppy code. Try this instead.

The error you enter into column G must be the same as a sheet name. for
example if you enter Error 3 there must be a sheet of that name and note that
Error 3 is not the same as Error3 with no space. Upper or lower case doesn't
matter.

If you want to add more errors then simply add more lines in the select case
statement
Case Is = "ERROR 999"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)

but as noted before the must be a sheet called Error 999


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim Myrange As Range
If Target.Column <> 7 Then Exit Sub
Select Case UCase(Target.Value)
Case Is = "ERROR 1"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "ERROR 2"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "ERROR 3"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
End Select
If Not Myrange Is Nothing Then
lastrow = Sheets(Target.Value).Cells(Rows.Count, "A").End(xlUp).Row
Myrange.Copy Destination:=Sheets(Target.Value).Range("A" & lastrow + 1)
'myrange.ClearContents
End If
End Sub

Mike
 
O

OfficeMan

Thanks again, this time there is no errors, However the row do not copy.

I have a form created on the main sheet, the form will fill in every column
however once the G colum gets the input of either Error2 or Error3 I want
that row to copy to the sheet corresponding to it, named either Error2 or
Error 3.
I have the sheets named as the inputs. I have this so far.

Note. My input rows start on row # 6 maybe that helps. Thanks again.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)

Dim Myrange As Range
If Target.Column <> 7 Then Exit Sub
Select Case UCase(Target.Value)
Case Is = "Erro1"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "Error2"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "Error3"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
End Select
If Not Myrange Is Nothing Then
lastrow = Sheets(Target.Value).Cells(Rows.Count, "A").End(xlUp).Row
Myrange.copy Destination:=Sheets(Target.Value).Range("A" & lastrow + 1)

End If
End Sub
 
D

Dave Peterson

You're checking for upper case:

Select Case UCase(Target.Value)

But this will never match any upper case string:
Case Is = "Erro1"

You could use this:
Select Case UCase(Target.Value)
Case Is = "ERRO1" '<-- you left out an R!!!

or

Select Case UCase(Target.Value)
Case Is = ucase("Erro1")

But watch your spelling, too.
 
M

Mike H

Hi,

Your file is back and fixed
http://www.savefile.com/files/1842462
Nice coding on that userform by the way

Now then the fix is in the book and the code below. We are doing text
comparisons and its far to error prone to rely on typing in the correct case
so note that below i've changed the sheet names to upper case. Note this
doesn't mean you have to chnage anything in your dropdown. But when you add
extra lines to select case you enter then in upper case

Select Case UCase(Target.Value)
Case Is = "ANOTHER REASON

Mike

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim Myrange As Range
If Target.Column <> 7 Then Exit Sub
Select Case UCase(Target.Value)
Case Is = "NO NOTES IN CSI"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "N0 XFR CODE"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
Case Is = "WRONG XFR TYPE"
Set Myrange = Target.Offset(0, -6).Resize(1, 7)
End Select
If Not Myrange Is Nothing Then
lastrow = Sheets(Target.Value).Cells(Rows.Count, "A").End(xlUp).Row
Myrange.Copy Destination:=Sheets(Target.Value).Range("A" & lastrow + 1)
End If
End Sub
 
O

OfficeMan

Thanks a lot... really appreciate it.

Question... would it be too difficult to make the row copy itself?

I mean the moment I enter the error name on column G it copies to the sheet
automatically? Instead of double clicking?

thanks
 
M

Mike H

Hi,

I changed your code for the userform button. When you click it the data are
now written to their respective sheets

Private Sub ENTERANDSAVE_Click()
ActiveWorkbook.Sheets("TRANSFER-ERRORS").Activate
Range("A6").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.Value = Boxname.Value
ActiveCell.Offset(0, 1) = Boxdate.Value
ActiveCell.Offset(0, 2) = Boxsup.Value
ActiveCell.Offset(0, 3) = Boxlead.Value
ActiveCell.Offset(0, 4) = Boxmanager.Value
ActiveCell.Offset(0, 5) = BoxSub.Value
ActiveCell.Offset(0, 6) = ERRORLIST.Value
'*************
'New code
Dim Myrange As Range
Select Case UCase(ERRORLIST.Value)
Case Is = "NO NOTES IN CSI"
Set Myrange = ActiveCell.Resize(1, 7)
Case Is = "NO XFR CODE"
Set Myrange = ActiveCell.Resize(1, 7)
Case Is = "WRONG XFR TYPE"
Set Myrange = ActiveCell.Resize(1, 7)
End Select
If Not Myrange Is Nothing Then
lastrow = Sheets(ERRORLIST.Value).Cells(Rows.Count, "A").End(xlUp).Row
Myrange.Copy Destination:=Sheets(ERRORLIST.Value).Range("A" & lastrow + 1)
End If
End Sub

Mike
 
O

OfficeMan

Ummm... after I input info to columns the system would not copy the row to
its sheet ....

double clicking works.. but I was wondering if it can be done automatically..

Thanks again.
 
M

Mike H

You need to paste the revised code from my last post into the button on your
userform and then delete the double click event code
 
O

OfficeMan

Done... however now I get an error "Compile Error" and it highligts this line
Select Case UCase(ERRORLIST.Value)
on the Main sheet code.

The form code no errors.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top