Question : Copy cell using Copy Function in VBA

I am trying to copy one worksheets contents to another worksheet cell by cell &
a row at a time. This is because not all the fields need to be copied across & the data
within some columns needs to be reformatted to fit correctly in the new worksheet.

For that I written macro but it can not copy values. I want to copy only values not formula. please advise.
Please find below code for same.

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

           
           
             Sub CopyField()
 
 
    Set sourceSheet = Sheets("Field Template")
    Set targetSheet = Sheets("Field")
    
    templateNumber = targetSheet.Range("h3")
    templateName = sourceSheet.Range("M3").Offset(templateNumber, 0)
        
    'find selected template
    Set baseCell = sourceSheet.Range("A:A").Find(templateName, LookIn:=xlValues)
    baseRow = baseCell.Row
    
    'this version succesfully pastes just the unprotected cells and doesn't created errorneus results posting blank cells - BUT the formulas paste vs. just values
    'Application.CutCopyMode = False
    'sourceSheet.Range(sourceSheet.Cells(baseRow, 3), sourceSheet.Cells(baseRow + 10, 10)).Select
    'Copy targetSheet.Range("C6")
    
    'sourceSheet.Select
    'this version successfully does a copy and past special but errorneous results pccur when the blank cells are posted
    'Range(sourceSheet.Cells(baseRow, 3), sourceSheet.Cells(baseRow + 10, 10)).Select
    'Selection.Copy
    'Sheets("Field").Select
    'Range("C6").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    sourceSheet.Range(sourceSheet.Cells(baseRow, 4), sourceSheet.Cells(baseRow + 10, 10)).Copy targetSheet.Range("D6")
    
' this version succesfully pastes just the unprotected cells and doesn't created errorneus results posting blank cells - BUT the formulas paste vs. just values
    For r = 0 To 10
        For c = 4 To 10
            With sourceSheet.Cells(baseRow + r, c)
                If .Locked = False Then 'only copy unlocked cells                   
                    .Copy targetSheet.Cells(r + 6, c)                   
                End If
            End With
        Next c
    Next r
   
End Sub

           
         

Open in New Window

Select All

Answer : Copy cell using Copy Function in VBA

I made a little mistake, could you test the following:

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:

           
           
             Sub CopyField()
Application.ScreenUpdating = False
 
    Set sourceSheet = Sheets("Field Template")
    Set targetSheet = Sheets("Field")
    
    templateNumber = targetSheet.Range("h3")
    templateName = sourceSheet.Range("M3").Offset(templateNumber, 0)
        
    'find selected template
    Set baseCell = sourceSheet.Range("A:A").Find(templateName, LookIn:=xlValues)
    baseRow = baseCell.Row
    
    'this version succesfully pastes just the unprotected cells and doesn't created errorneus results posting blank cells - BUT the formulas paste vs. just values
    'Application.CutCopyMode = False
    'sourceSheet.Range(sourceSheet.Cells(baseRow, 3), sourceSheet.Cells(baseRow + 10, 10)).Select
    'Copy targetSheet.Range("C6")
    
    'sourceSheet.Select
    'this version successfully does a copy and past special but errorneous results pccur when the blank cells are posted
    'Range(sourceSheet.Cells(baseRow, 3), sourceSheet.Cells(baseRow + 10, 10)).Select
    'Selection.Copy
    'Sheets("Field").Select
    'Range("C6").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    targetSheet.Range("D6").Value = sourceSheet.Range(sourceSheet.Cells(baseRow, 4), sourceSheet.Cells(baseRow + 10, 10)).Value
    
' this version succesfully pastes just the unprotected cells and doesn't created errorneus results posting blank cells - BUT the formulas paste vs. just values
    For r = 0 To 10
        For c = 4 To 10
            With sourceSheet.Cells(baseRow + r, c)
                If .Locked = False Then 'only copy unlocked cells
                    targetSheet.Cells(r + 6, c).Value = sourceSheet.Cells(baseRow + r, c).Value
                End If
            End With
        Next c
    Next r
   
Application.ScreenUpdating = True
End Sub

           
         

Open in New Window

Select All