Copying cells from one sheet to another sheet


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Results 1 to 1 of 1

Thread: Copying cells from one sheet to another sheet

Hybrid View

  1. #1
    Join Date
    Nov 2007
    Posts
    11

    Post Copying cells from one sheet to another sheet

    I have finally pulled together a way of finding my old key number and generating a new unique number then erasing the old key number and the other cells in the row which hold information about that key.

    But i want to copy all the cells which contain information for the old key number to sheet 2 on my excel workbook before the new key number is assigned to the row and the cells are overwritten.

    Can someone help me with some VB script?

    Thanks De_haviland
    Code:
    Private Sub CommandButton1_Click()
        Dim strDeleteKey As String
        Dim strNewKey As String
        Dim strFirstAddress As String
        Dim strMsg As String
        Dim strKeySearchResult As String
        Dim strKeyPrefix As String
        Dim strKeyAddress As String
        Dim rngKeySearch As Range
        Dim rngKeySearch2 As Range
        Dim intKeyCount As Integer
        Dim intNewKey As Integer
        Dim intKeySearchResult As Integer
        Dim varHighestValue As Variant
        Unload Kng
        Dim arrKeys(2) As Integer
        
        intKeyCount = 0
        
        strDeleteKey = InputBox("Re-enter number to permanantly delete")
        
        If Trim(strDeleteKey) <> "" Then
            With Sheets("Properties on Keywatch").Range("A:A")
            
                Set rngKeySearch = .Find(What:=strDeleteKey, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
            ActiveCell.EntireRow.Copy
                                
                If Not rngKeySearch Is Nothing Then
                    strKeyAddress = rngKeySearch.Address
                    strKeyPrefix = Left(strDeleteKey, 2)
                    
                    Set rngKeySearch2 = .Find(What:=strKeyPrefix, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlFormulas, _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                    
                    If Not rngKeySearch2 Is Nothing Then
                        strFirstAddress = rngKeySearch2.Address
                        Do
                            strKeySearchResult = Right(CStr(rngKeySearch2.Text), 3)
                            intKeySearchResult = CInt(strKeySearchResult)
                        
                            arrKeys(intKeyCount) = intKeySearchResult
                    
                            Set rngKeySearch2 = .FindNext(rngKeySearch2)
                        
                            intKeyCount = intKeyCount + 1
                        Loop While Not rngKeySearch2 Is Nothing And rngKeySearch2.Address <> strFirstAddress
                    End If               
                    
                    varHighestValue = WorksheetFunction.Max(arrKeys)
                
                    intNewKey = CInt(varHighestValue) + 1
                    
                    If intNewKey = 99 Then
                        strMsg = "No key number slots remaining on hook " & strKeyPrefix
                    Else
                        strNewKey = Left(strDeleteKey, 1) & CStr(intNewKey)
                    
                        Application.Goto rngKeySearch, True
                    
                        ActiveCell = strNewKey
                        ActiveCell.Offset(0, 1) = ""
                        ActiveCell.Offset(0, 2) = ""
                        ActiveCell.Offset(0, 3) = ""
                        ActiveCell.Offset(0, 4) = ""
                    
                        strMsg = "Key " & strDeleteKey & " has been deleted. Key " & strNewKey & " created ready for use."
                    End If
                        MsgBox (strMsg)
                Else
                    MsgBox "Key does not exist. Please re-enter"
                End If
            End With
        End If
        Sheets("Sheet2").Select
        Range("A1").Select
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
        ActiveCell.PasteSpecial
               
    End Sub
    Last edited by Hack; 11-15-2007 at 09:09 AM. Reason: Added Code Tags

Similar Threads

  1. Replies: 12
    Last Post: 03-09-2010, 10:51 AM
  2. I need to move my controls into table cells
    By Matrix.net in forum ASP.NET
    Replies: 1
    Last Post: 08-22-2006, 04:29 PM
  3. Drawing an image in excel sheet using HSSF API
    By upendranathr in forum Java
    Replies: 0
    Last Post: 08-21-2006, 06:49 AM
  4. Checking existance of a Sheet
    By pvrajesh31 in forum VB Classic
    Replies: 2
    Last Post: 02-21-2006, 07:29 AM
  5. Style Sheet Problem with Websphere
    By cmorrell in forum Java
    Replies: 0
    Last Post: 09-01-2005, 10:12 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center