copy Range in Value & Paste Special form.

Hello Experts' & Guru's

We are using a VBA code in my project file for copy a Range ("A115:U215") from one sheet to another sheet (prarup-1) when A specif cell value "Y"

part of code line in below

With Sheets("Prarup-1").Cells(Rows.Count, 2).End(xlUp)(2).Resize(101, 21)
            .Parent.Visible = -1
            .Value = Range("A115:U215").Value
            .Cells(.Rows.Count, 8).Resize(, 6).FormulaR1C1 = "=SUM(R[" & 1 - .Rows.Count & "]C:R[-1]C)"
            On Error Resume Next
            For i = .Rows.Count To 1 Step -1
                If .Rows(i).Text = vbNullString Then .Rows(i).EntireRow.Delete
            Next i
            On Error GoTo 0
            .Offset(, -1).Resize(, 12).Borders.LineStyle = xlContinuous
        End With

We want in Above Range A115:I215 & N115:U215 in Value & J115 to M215 in Paste Special Form..... pls suggest me where & what i change in above code

Thanks in advance

Hi, santosh226001,

maybe indicate where to put the values as I doubt they all should be placed into the very same area. And you would need to epxlain if any further action is to be made for these cells as well.

The code may look like (untested)

With Sheets("Prarup-1").Cells(Rows.Count, 2).End(xlUp)(2).Resize(1, 9)
    .Parent.Visible = -1
    .Value = Range("A115:I115").Value
    .Offset(, 1).Value = Range("N115:U115").Value
    Range("J115:M115").Copy
    .Offset(, 2).PasteSpecial Operation:=xlPasteFormulas
'...

Ciao,
Holger

hello Holge thanks for reply

when u add this lines in my code as follwing

With Sheets("Prarup-1").Cells(Rows.Count, 2).End(xlUp)(2).Resize(1, 9)
    .Parent.Visible = -1
    .Value = Range("A115:I115").Value
    .Offset(, 1).Value = Range("N115:U115").Value
    Range("J115:M115").Copy
    .Offset(, 2).PasteSpecial Operation:=xlPasteFormulas
            .Cells(.Rows.Count, 8).Resize(, 6).FormulaR1C1 = "=SUM(R[" & 1 - .Rows.Count & "]C:R[-1]C)"
            On Error Resume Next
            For i = .Rows.Count To 1 Step -1
                If .Rows(i).Text = vbNullString Then .Rows(i).EntireRow.Delete
            Next i
            On Error GoTo 0
            .Offset(, -1).Resize(, 12).Borders.LineStyle = xlContinuous
        End With

Thank this msg disply in run time

"Run-time error'1004'
Paste Special method of Range Class Failed


Sir in previous code Resize(101, 21) but u suggested Resize(1, 9)


& Sorry also when we chek we error range is A115 to U215 ... sorry sorry plss... it's not a single row data it's 100 rows data.. pls..

Hi, santosh226001,

please have a look at the Forum Rules (especially 6a: Never edit a thread or post to which others have already responded).

Originally Posted by HaHoBe

indicate where to put the values as I doubt they all should be placed into the very same area

Nice still to have no information about that because that may help finding a solution.

What about a workbook for testing? I must admit that the offset is wrong (should adapt the ranges properly and not be 1 but at least 10 or even more if your areas are wider). And about the pastespecial: usually itīs the first cell which is given as destination. But somebody certainly "tailored" that code for a reason unknown to me so maybe use 2 With-Staments instead of just one to take care of both ranges for values as well as a single cell for pastespecial.

range is A115 to U215 ... sorry sorry plss... it's not a single row data it's 100 rows data.

Hm - 115 to 215 makes 101 rows for me.

Ciao,
Holger

Hi, santosh226001,

what formulas as there are none in the sample in the area you want excluded from values? If itīs a sum in Column N for the cells in the left of that column I would add them like the sum at the bottom of the copied range. It really would help me if the sample and the result would reflect what you are after instead of guessing what it might or not be.

Ciao,
Holger

Hi, santosh226001,

maybe try this alteration where I used a new variable to hold the first empty row in Sheet Prarub-1:

        With Sheets("Prarup-1")
            lngFF = .Cells(Rows.Count, 2).End(xlUp)(2).Row
            With .Cells(lngFF, "B").Resize(101, 21)
              .Parent.Visible = -1
              .Value = Range("A115:U215").Value
              .Range("J115:M215").Copy
              Sheets("Prarup-1").Cells(lngFF, "K").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                      SkipBlanks:=False, Transpose:=False
              .Cells(.Rows.Count, 8).Resize(, 6).FormulaR1C1 = "=SUM(R[" & 1 - .Rows.Count & "]C:R[-1]C)"
'...

Ciao,
Holger

Hi, santosh226001,

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("K107,F2,a24,a44,a54,a64,a74,a84")) Is Nothing Then Exit Sub

Dim r As Range, i As Long, lngFF As Long

Set r = Sheets("Roadlist").Columns(2).Find(Range("F2").Value, lookat:=xlWhole)
If r Is Nothing Then
  MsgBox "not found " & Range("F2").Value, 64
  Exit Sub
End If

' check with Roadlist sheet that road if already enter
If r(1, 8) = "Enter" Then
  MsgBox r & " Data already Enter..", 64
  Exit Sub
End If

Select Case Target.Address(0, 0)

    Case "F2"
        Sheets("Entry").Unprotect Password:="san"
        Application.EnableEvents = False
        Range("k2").Value = r(1, 2)
        If r(1, 4) <= 20 Then Rows("26:104").Hidden = True
        Application.EnableEvents = True
        Sheets("Entry").Protect Password:="san"
'        Application.StatusBar = "This is msg box"
    
    Case "K107"
        If Target.Text = "N" Then MsgBox "You Choose No .. so NO Record Post": Exit Sub
        If MsgBox("Are you Sure You Want to Save Entered Road Record?", vbYesNo, _
                  "Confermation Yes or Not") = vbNo Then Exit Sub
        If Range("m106").Value <> "Data Ok" Then MsgBox "Data Not Correct... See Row Number 106 for Errors!!": Exit Sub

        ' copy prarup1
        With Sheets("Prarup-1")
            lngFF = .Cells(Rows.Count, 2).End(xlUp)(2).Row
            With .Cells(lngFF, "B").Resize(101, 21)
              .Parent.Visible = -1
              .Value = Range("A115:U215").Value
              .Range("J115:M215").Copy
              Sheets("Prarup-1").Cells(lngFF, "K").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
                      SkipBlanks:=False, Transpose:=False
              .Cells(.Rows.Count, 8).Resize(, 6).FormulaR1C1 = "=SUM(R[" & 1 - .Rows.Count & "]C:R[-1]C)"
              On Error Resume Next
              For i = .Rows.Count To 1 Step -1
                  If .Rows(i).Text = vbNullString Then .Rows(i).EntireRow.Delete
              Next i
              On Error GoTo 0
              .Offset(, -1).Resize(, 12).Borders.LineStyle = xlContinuous
          End With
        End With
        
        ' copy to prarup2
        With Sheets("Prarup-2").Cells(Rows.Count, 2).End(xlUp)(2).Resize(, 137)
            .Value = Range("A111:EG111").Value
            .Offset(, -1).Resize(, 52).Borders.LineStyle = xlContinuous
        End With
        Application.EnableEvents = False
        Target.Value = "N"
        ' copy workbook after each entry record
'        ActiveWorkbook.Save
        Sheets("Entry").Unprotect Password:="san"
        Range("F2:i2,k2").ClearContents: Range("A5:j104").SpecialCells(2).ClearContents
        Sheets("Entry").Protect Password:="san"
        Sheets("Prarup-2").Visible = xlVeryHidden
'        Range("a5").Select
        Application.EnableEvents = True
      
    Case "A24"
        Sheets("Entry").Unprotect Password:="san"
        Rows("25:44").Hidden = False
        Sheets("Entry").Protect Password:="san"

    Case "A44"
        Sheets("Entry").Unprotect Password:="san"
        Rows("45:54").Hidden = False
        Sheets("Entry").Protect Password:="san"

    Case "A54"
        Sheets("Entry").Unprotect Password:="san"
        Rows("55:64").Hidden = False
        Sheets("Entry").Protect Password:="san"

    Case "A64"
        Sheets("Entry").Unprotect Password:="san"
        Rows("65:74").Hidden = False
        Sheets("Entry").Protect Password:="san"

    Case "A74"
        Sheets("Entry").Unprotect Password:="san"
        Rows("75:84").Hidden = False
        Sheets("Entry").Protect Password:="san"

    Case "A84"
        Sheets("Entry").Unprotect Password:="san"
        Rows("85:104").Hidden = False
        Sheets("Entry").Protect Password:="san"
End Select

End Sub

CIao,
Holger