Link to home
Create AccountLog in
Avatar of Pabilio
PabilioFlag for Spain

asked on

COPY CELLS IN THE NEXT ROW....

Hi,

The code attached in the Code Snippet do as follows:

When a cell located in Column B is double clicked it changes from cero to one and the code copies some cells from the same ROW of the "activated" cell and paste those cells on sheet "PRINT" and then print the sheet and clear contents to be ready for the next print action.

What I need to add to the code is the action to copy the same cells to be printed but in a different Sheet (HISTORY) (not for printing)....and when I active a new cell on Column B the new "set" of cells will be pasted in the following (empty) row on HISTORY Sheet.

I appreciate your help on this matter.

Regards,
Roberto.
Avatar of Daniel Wilson
Daniel Wilson
Flag of United States of America image

Your attached code didn't get attached.  Would you add it?

Thanks!
Avatar of Pabilio

ASKER

Here goes again....
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim lngRow As Long
     'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub
     'Isolate Target to a specific range
    If Intersect(Target, Range("tildes")) Is Nothing Then Exit Sub
    lngRow = Target.Row
     'set Target font tp "marlett"
    Target.Font.Name = "marlett"
     'Check value of target
    If Target.Value <> "1" Then
        Target.Value = "1" 'Sets target Value = "a"
        ' check it's column B
        If Target.Column = 2 Then
        With Sheets("PRINT")
            .Cells(4, "B").Value = Cells(lngRow, "R").Value
            .Cells(5, "B").Value = Cells(lngRow, "Q").Value
            .Cells(6, "B").Value = Cells(lngRow, "T").Value
            .Cells(7, "B").Value = Cells(lngRow, "G").Value
            .Cells(1, "E").Value = Cells(lngRow, "A").Value
            .Cells(16, "I").Value = Cells(lngRow, "A").Value
            .PrintOut From:=1, To:=1, Copies:=2, _
        ActivePrinter:="HP LaserJet 1220 Series PCL (Copiar 1) en Ne00:", Collate:= _
        True
            .Cells(4, "B").Resize(4).ClearContents
        End With
        End If
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "1" Then
        Target.ClearContents 'Sets Target Value = ""
        Cancel = True
        Exit Sub
    End If
End Sub

Open in new window

Avatar of Pabilio

ASKER

Help !!
:-(
how's this?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim lngRow As Long
     'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub
     'Isolate Target to a specific range
    If Intersect(Target, Range("tildes")) Is Nothing Then Exit Sub
    lngRow = Target.Row
     'set Target font tp "marlett"
    Target.Font.Name = "marlett"
     'Check value of target
    If Target.Value <> "1" Then
        Target.Value = "1" 'Sets target Value = "a"
        ' check it's column B
        If Target.Column = 2 Then
        With Sheets("PRINT")
            .Cells(4, "B").Value = Cells(lngRow, "R").Value
            .Cells(5, "B").Value = Cells(lngRow, "Q").Value
            .Cells(6, "B").Value = Cells(lngRow, "T").Value
            .Cells(7, "B").Value = Cells(lngRow, "G").Value
            .Cells(1, "E").Value = Cells(lngRow, "A").Value
            .Cells(16, "I").Value = Cells(lngRow, "A").Value
            .PrintOut From:=1, To:=1, Copies:=2, _
        ActivePrinter:="HP LaserJet 1220 Series PCL (Copiar 1) en Ne00:", Collate:= _
        True
            .Cells(4, "B").Resize(4).ClearContents
        End With
        With Sheets("HISTORY")
            .Cells(4, "B").Value = Cells(lngRow, "R").Value
            .Cells(5, "B").Value = Cells(lngRow, "Q").Value
            .Cells(6, "B").Value = Cells(lngRow, "T").Value
            .Cells(7, "B").Value = Cells(lngRow, "G").Value
            .Cells(1, "E").Value = Cells(lngRow, "A").Value
            .Cells(16, "I").Value = Cells(lngRow, "A").Value
        end with
        End If
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "1" Then
        Target.ClearContents 'Sets Target Value = ""
        Cancel = True
        Exit Sub
    End If
End Sub

Open in new window

Avatar of Pabilio

ASKER

Hi Daniel.

The code you posted does part of the job....it copy the cells in the sheet HISTORY but in the same way that it copies the cells in sheet PRINT....

I changed a bit the code you posted, so it now copies the cells in sheet HISTORY (but all cells in ROW 2 as I need it)....but if I activate a new cell with double click in Column B in the MAIN Sheet it will delete the previous data in ROW 2 in Sheet HISTORY.

What I need is when I "activate" with a double click a new cell in column B, apart from the PRINT action,  it also copy the cells but in the next ROW in Sheet HISTORY, Row 3 for this example....next in row 4 and so on... so I could Keep the record of prints done.

Could you help me with that ?

Thank you very much for your time.

Roberto.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim lngRow As Long
     'Limit Target count to 1
    If Target.Count > 1 Then Exit Sub
     'Isolate Target to a specific range
    If Intersect(Target, Range("tildes")) Is Nothing Then Exit Sub
    lngRow = Target.Row
     'set Target font tp "marlett"
    Target.Font.Name = "marlett"
     'Check value of target
    If Target.Value <> "1" Then
        Target.Value = "1" 'Sets target Value = "a"
        ' check it's column B
        If Target.Column = 2 Then
        With Sheets("PRINT")
            .Cells(4, "B").Value = Cells(lngRow, "R").Value
            .Cells(5, "B").Value = Cells(lngRow, "Q").Value
            .Cells(6, "B").Value = Cells(lngRow, "T").Value
            .Cells(7, "B").Value = Cells(lngRow, "G").Value
            .Cells(1, "E").Value = Cells(lngRow, "A").Value
            .Cells(16, "I").Value = Cells(lngRow, "A").Value
            .PrintOut From:=1, To:=1, Copies:=2, _
        ActivePrinter:="HP LaserJet 1220 Series PCL (Copiar 1) en Ne00:", Collate:= _
        True
            .Cells(4, "B").Resize(4).ClearContents
        End With
        With Sheets("HISTORY")
            .Cells(2, "A").Value = Cells(lngRow, "R").Value
            .Cells(2, "B").Value = Cells(lngRow, "Q").Value
            .Cells(2, "C").Value = Cells(lngRow, "T").Value
            .Cells(2, "D").Value = Cells(lngRow, "G").Value
            .Cells(2, "E").Value = Cells(lngRow, "A").Value
            .Cells(2, "F").Value = Cells(lngRow, "A").Value
        End With
        End If
        Cancel = True
        Exit Sub
    End If
    If Target.Value = "1" Then
        Target.ClearContents 'Sets Target Value = ""
        Cancel = True
        Exit Sub
    End If
End Sub

Open in new window

So you're needing to check what is the bottom populated row in History and populate the next row?
Avatar of Pabilio

ASKER

That is completly right Daniel
ASKER CERTIFIED SOLUTION
Avatar of Daniel Wilson
Daniel Wilson
Flag of United States of America image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of Pabilio

ASKER

Hi Daniel,

The code give me an error 1004 (Error difined by application or object)

The line highligted is:

While Trim(Sheets("HISTORY").Cells(lngNextHistRow, "A").Value) = ""

Located at the begining of the code.

Thank you very much for your help.

Roberto.
That should have been a <> instead of =

But that's not what's causing that error ...

Let's try dropping the Trim().

while Sheets("HISTORY").Cells(lngNextHistRow , "A").Value <> ""

Open in new window

Avatar of Pabilio

ASKER

Daniel,

Same error...same line.

Roberto.
Avatar of Pabilio

ASKER

Hi Daniel,

I also tried:
While Trim(Sheets("HISTORY").Cells(lngNextHistRow, "A").Value) <> ""

But as you said this is not what is causing the error.

I tried some other stuff but my best result is a hanged computer.

Thank you for your time.
Roberto.

Avatar of Pabilio

ASKER

Hi Daniel....

The trim was ok...the problem was the row call in HISTORY Sheet:

While Trim(Sheets("PLANILLAS").Cells(L , "A").Value) <> ""
Does the trick.

Thank you very much for your help.
Roberto.