Results 1 to 16 of 16

Copying Data without overwriting (edit macro)

Threaded View

  1. #1
    Registered User
    Join Date
    10-20-2010
    Location
    Berlin
    MS-Off Ver
    Excel 2003
    Posts
    39

    Exclamation Copying Data without overwriting (edit macro)

    I have the following macro that copies data from sheet1 and pastes it to sheet2.

    I want to edit this macro to not overwrite the data in sheet2 when pasting in the data from sheet1. it should only paste in the data if the respective cell is empty. if something is already there it should just move on to the next cell.

    Previously what this macro did was it saved the old data as a comment in the respective cell (sheet2) and pasted in the data from sheet1.

    JN


    Option Explicit
    Option Base 1
    
    Sub CopyData()
    Dim MyRg As Range
    Dim MyData()
    Dim SrchRg As Range
    Dim MyVal As Range
    Dim F
    Dim ColSRC, ColDEST
    Dim I As Integer
    Dim TextVal As String
    Dim NbCol As Integer
        NbCol = 3           '  NB OF COLUMNS TO TREAT
        ReDim MyData(NbCol)
        ColSRC = Array("D", "F", "H")  '  HERE  TO MENTION COLUMNS IN SHEET 1  WHERE TO GET DATA
        ColDEST = Array("F", "D", "I") '  HERE  TO MENTION COLUMNS IN SHEET 2  WHERE TO PÜT DATA
        
        With Sheets("Sheet1")
            Set MyRg = .Range(.Range("C5"), .Range("C" & Rows.Count).End(xlUp))
            On Error Resume Next
            For Each MyVal In MyRg
                For I = 1 To NbCol
                    MyData(I) = .Cells(MyVal.Row, ColSRC(I))
                Next I
                
                With Sheets("Sheet2")
                    Set SrchRg = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
                    With SrchRg
                        Set F = .Find(What:=MyVal, After:=.Cells(1, 1), LookIn:=xlValues, _
                                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=False)
                        If (Not F Is Nothing) Then
                            For I = 1 To NbCol
                                With .Cells(F.Row, ColDEST(I))
                                    If (.Value <> Empty) Then
                                        .AddComment
                                        .Comment.Visible = False
                                        TextVal = .Value
                                        .Comment.Text Text:=TextVal
                                    End If
                                    .Value = MyData(I)
                                End With
                            Next I
                        End If
                    End With
                End With
            Next MyVal
        End With
    End Sub
    posting here too:
    http://www.mrexcel.com/forum/showthread.php?t=532593
    Last edited by jimmy_nora; 03-01-2011 at 10:40 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1