VBA copy cell to another worksheet

  • Thread starter Thread starter franco monte
  • Start date Start date
F

franco monte

Hello, I am trying to copy text information from one worksheet to
another.
I open only the first sheet then I have a comand button by where I
want to say transfer the values.

La macro give an error at ObjWorshett.Cells(Riga, 1).text =
oDO.GetText
Errore di run-time '1004'.
Errore definito dall'applicazione o dall'oggetto.
Thanks in advance!
Franco



Dim oDO As New DataObject
oDO.SetText [B2].Value
oDO.PutInClipboard

Dim ObjWorshett As Worksheet
Dim strNomeFile As String

strNomeFile = "\\srv01\Dp\ANTONELLA\sblocco.xls"
Set ObjWorshett = Application.Workbooks.Open(strNomeFile, False,
True).Sheets(1)
UltimaRiga = ObjWorshett.Range("A65356").End(xlUp).Row
Riga = UltimaRiga + 1

oDO.GetFromClipboard
ObjWorshett.Cells(Riga, 1).text = oDO.GetText
Set oDO = Nothing

ObjWorshett.Application.ActiveWorkbook.Close
 
I hope I have understood your needs and that this helps you. I don't believe
you need to use the clipboard for this. You can copy the value in cell B2 on
the active sheet (the one with the command button on it) and place it into
the other workbook.

Also, you were opening the sblocco.xls workbook as Read Only which means you
could not save the change you make to it. I have changed that.

Sub CopyCellValue()
Dim ObjWorshett As Worksheet
Dim strNomeFile As String
Dim UltimaRiga As Long
Dim Riga As Long

' new variables used
Dim objWorkbook As Workbook
Dim valueFromThisWorkbook As Variant

'get the value in Cell B2 on the sheet
'that is active in this workbook
valueFromThisWorkbook = ActiveSheet.Range("B2").Value

strNomeFile = "\\srv01\Dp\ANTONELLA\sblocco.xls"

'open the other workbook, do not update links, _
do NOT open as read only
Set objWorkbook = Workbooks.Open(strNomeFile, False, False)
Set ObjWorshett = objWorkbook.Sheets(1)

UltimaRiga = ObjWorshett.Range("A" & Rows.Count).End(xlUp).Row
Riga = UltimaRiga + 1
'if you do not need UltimaRiga later, you can rewrite those
'two statements as one:
' Riga = ObjWorshett.Range("A" & Rows.Count).End(xlUp).Row + 1

ObjWorshett.Cells(Riga, 1).Value = valueFromThisWorkbook
Set ObjWorshett = Nothing
objWorkbook.Close True ' close and save changes
Set objWorkbook = Nothing
End Sub
 
Thanks JLatham, it's exactly that I want!
But on the line --> Set objWorkbook = Workbooks.Open(strNomeFile,
False, False)
I have the same error:
Errore di run-time '1004'.
Errore definito dall'applicazione o dall'oggetto.
I'm searching for on the net but Your help is appreciated!
Thanks again
 
It works properly for me under several tests. So we need to focus in on what
part of the command is not working properly.

Set up some test code and see if it works:

Sub TestFileOpen()
Workbooks.Open("\\srv01\Dp\ANTONELLA\sblocco.xls")
End Sub

If that does not work properly, check to be certain that the path to the
file is correct.

If that does work, then change the code and test again:
Sub TestFileOpen()
Workbooks.Open("\\srv01\Dp\ANTONELLA\sblocco.xls", False, False)
End Sub

And if that also works properly, test a little more:
Sub TestFileOpen()
Dim strNomeFile As String

strNomeFile = "\\srv01\Dp\ANTONELLA\sblocco.xls"
Workbooks.Open(strNomeFile, False, False)
End Sub

and once more, if that succeeds, move on to another test
Sub TestFileOpen()
Dim objWorkbook As Workbook
Dim strNomeFile As String

strNomeFile = "\\srv01\Dp\ANTONELLA\sblocco.xls"
Workbooks.Open(strNomeFile, False, False)
Set objWorkbook = Workbooks(ActiveWorkbook.Name)
ThisWorkbook.Activate
End Sub
 
Thanks JLatham, now it's work correct! Thanks again!!!!

Private Sub Memorizza_Click()
Dim ObjWorshett As Worksheet
Dim strNomeFile As String
Dim UltimaRiga As Long
Dim Riga As Long

' new variables used
Dim objWorkbook As Workbook
Dim valueFromThisWorkbook As Variant

Application.ScreenUpdating = False ' Lavora in background

valueB2 = ActiveSheet.Range("B2").Value 'Agente
' ....

strNomeFile = "\\srv01\Dp\ANTONELLA\Lista sblocco ordini.xls"

'open the other workbook, do not update links, _
do NOT open as read only
Set objWorkbook = Workbooks.Open(strNomeFile, False, False)
Set ObjWorshett = objWorkbook.Sheets(1)

UltimaRiga = ObjWorshett.Range("A" & Rows.Count).End(xlUp).Row
Riga = UltimaRiga + 1

ObjWorshett.Cells(Riga, 1).Value = valueB2 'Agente
' ....

Set ObjWorshett = Nothing
objWorkbook.Close True ' close and save changes
Set objWorkbook = Nothing
Application.ScreenUpdating = True ' Fine Lavora in background
End Sub
 
Back
Top