Button in a sheet to copy conents of a cell fom another sheet

A

alikhalil

New member
Joined
Jan 29, 2017
Messages
27
Reaction score
0
Points
0
Hello, I have the following macro embedded in a button on one sheet that copies the data on that sheet. But I'd like to place the button on another sheet whilst maintaining the same function. I'm using the following code for the button. What should I change to make it reference a particular sheet instead of the active one?

PS: The original excel file has too many sensitive data so sharing it will be difficult. My apologies.

Sub CopyData()

Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Dim length As Long

Dim counter As Integer
Dim vData As Variant

Dim objData As Object
Set objData = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

'If Len(Range("B2").Value) < 3 Then
' MsgBox "Please select CPE location", vbInformation, "Try Again"
' Exit Sub
If Len(Range("ACS!E2").Value) < 3 Or IsIPvalid(Range("ACS!E2").Value) = False Then
MsgBox "Please fill-in the IP field" & vbCr & "with a valid one", vbInformation, "Try Again"
Exit Sub
End If

Application.ScreenUpdating = False
On Error GoTo EndMacro:

With ActiveSheet.UsedRange
StartRow = .Cells(4, 1).Row
StartCol = .Cells(7).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With

counter = 0
vData = ""
Application.Calculate

For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = "" 'Chr(34) & Chr(34)
Else
CellValue = Cells(RowNdx, ColNdx).Value
End If
WholeLine = WholeLine & CellValue ' & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))

If Len(WholeLine) > 0 Then
If counter >= 1 Then
vData = vData & vbCr & vbLf
End If
'Debug.Print counter & " " & RowNdx
vData = vData & WholeLine & vbCr & vbLf
counter = 0
Else
counter = counter + 1
End If

Next RowNdx

With objData
.SetText vData
.PutInClipboard
End With

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
Click to expand...
 
Last edited:
'here added to lines with changes:
Code: 
Sub CopyData()
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String

Dim length As Long

Dim counter As Integer
Dim vData As Variant

Dim objData As Object
Set objData = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

'If Len(Range("B2").Value) < 3 Then
' MsgBox "Please select CPE location", vbInformation, "Try Again"
' Exit Sub
With Sheets("TheSpecificSheetsNameHere") 'adjust this line to suit. here
  If Len(.Range("ACS!E2").Value) < 3 Or IsIPvalid(.Range("ACS!E2").Value) = False Then  'here
    MsgBox "Please fill-in the IP field" & vbCr & "with a valid one", vbInformation, "Try Again"
    Exit Sub
  End If

  Application.ScreenUpdating = False
  On Error GoTo EndMacro:

  With .UsedRange 'here
    StartRow = .Cells(4, 1).Row  
    StartCol = .Cells(7).Column
    EndRow = .Cells(.Cells.Count).Row
    EndCol = .Cells(.Cells.Count).Column
  End With

  counter = 0
  vData = ""
  Application.Calculate

  For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
      If .Cells(RowNdx, ColNdx).Value = "" Then  'here
        CellValue = ""  'Chr(34) & Chr(34)
      Else
        CellValue = .Cells(RowNdx, ColNdx).Value  'here
      End If
      WholeLine = WholeLine & CellValue  ' & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))

    If Len(WholeLine) > 0 Then
      If counter >= 1 Then
        vData = vData & vbCr & vbLf
      End If
      'Debug.Print counter & " " & RowNdx
      vData = vData & WholeLine & vbCr & vbLf
      counter = 0
    Else
      counter = counter + 1
    End If

  Next RowNdx
End With

With objData
  .SetText vData
  .PutInClipboard
End With

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
 
Not much of a programmer and ended up with an error. Sorry T.T I think it'll be easier if i upload a dummy version of the file.
View attachment test1.xlsm
The main sheet I'd like to have the copy button on is the ACS and each sheet should have a designated copy button on ACS that would copy its content without navigating through the sheets.
 
In your attachment there are some 1200 lines of code, some 250 of them comments. I never let macros run on first opening a file from the internet so that I can investigste it first (learnt that the hard way). 2 points:
1. I'm not going to scan 1200 lines of code lookng for code that might do stuff I don't want it to.
2. From what I can see it looks as if I may need to be on a network of some size to produce data on the ACS sheet to work on.
3. Although you say you get an error, you don't say what kind of error, nor which line of code that error occurs on. (You may need temporarily to disable some On Error lines in order to find more exactly what error(s) occur.)
4. I ran the code in my previous message on sheet ACS and apart from there being nothing in cell E2 (I commented out that check) I got no error (and nothing in the clipboard either!)

So what you need to do is provide a dummy file again, with (dummy) data to work on in the ACS sheet (you probably need only have this one sheet in the file) without all the other code in, where you have tried running the copying code and get the same error.
Then I should be able to find the problem.
 
Hi
p45cal

Sorry went MIA for a while before being able to test it out properly. Alright so my apologies the code works and does its intended purpose. I'm thinking of duplicating the macro for the rest of the buttons that link to the other sheet. Here's a screenshot of the error I got

1.jpg

And when I debug it shows that there's a problem with the if statement

2.jpg

If I remove the if statement completely the error goes away but I need to verify the values so that the sheet won't be misused. Can you please help one more time?

Thanks!
 
my mistake, take the red dots out from this line:
If Len(.Range("ACS!E2").Value) < 3 Or IsIPvalid(.Range("ACS!E2").Value) = False Then 'here


leaving:
If Len(Range("ACS!E2").Value) < 3 Or IsIPvalid(Range("ACS!E2").Value) = False Then 'here
 
Can someone look into this please?

now there's another problem where the second line always has the word "False" added to before it. And then there's the the CISCO sheet copy button when copies nothing even though I used the same code on all buttons and in all sheets.
Click to expand...


Thank you
 
Last edited by a moderator:
You sent me a PM (which included a file that I took to be data-sensitve) on 17th of this month to which I replied on the 19th.
If you were to answer the questions in that reply perhaps we could make progress.
 
p45cal said:
You sent me a PM (which included a file that I took to be data-sensitve) on 17th of this month to which I replied on the 19th.
If you were to answer the questions in that reply perhaps we could make progress.
Click to expand...

For some reason I didn't notice/get notified of your PM reply as I was waiting and thought you were busy thus didn't want to disturb. Otherwise yes, I would rather not have had the file put up in here.
 
You must log in or register to reply here.
Back
Top