Code for copy and pasting in excel

[Veeru]

Can we have code , which do below things


It should copy from Raw and paste in sheet1 till last row


Now it should calculate sheet1 rows :-

1. If sheet1 rows are less, then it should create additional rows to fit it Raw sheet data and total at last.
2. If sheet1 rows are more, then it should delete additional rows and total at last.

Thanks for your guidance as always

[mdmackillop]

Try doing it yourself using the Macro recorder. Let us know if you have any problems.

[Veeru]

Hi,

I can try and I guess it will work for this report and range.

Currently if I am selecting a range A16 then it will work fine but next time when my range changes let’s say A110 then it will only perform its task on till D6 only.

So it will not work correctly next time. I have develop one code to copy till last row and paste it but exactly needed is it should not overwrite Total row and paste everything above it.

If current data rows are less than existing rows then delete it and if more then insert new rows and maintain total row as it is.


Thanks

[Veeru]

I have already attached one work book named "Net". thanks

[Veeru]

Small changes...what we want is copy from Raw tab and paste in Sheet1 but col A and Col. B.
I have developed below code but it is copying everything and pasting everything.

Sub Demo()
Dim LR As Long
Worksheets("Raw").Select
Range("A1").Select: Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy
Worksheets("Sheet1").Select
Range("A1").PasteSpecial
LR = Range("D" & Rows.Count).End(xlUp).Row
Range("D" & LR + 1).Formula = "=SUM(D2:D" & LR & ")"
MsgBox "Completed"
End Sub

[mdmackillop]

what we want is copy from Raw tab and paste in Sheet1 but col A and Col. B

I'm not clear what you mean by this.

Good attempt but avoid Selecting in your code

Sub Demo1()
Dim LR As Long
Dim c As Range
Set c = Worksheets("Raw").Range("A1")
Range(c, c.End(xlToRight).End(xlDown)).Copy Worksheets("Sheet1").Range("A1")
With Worksheets("Sheet1")
LR = .Range("D" & Rows.Count).End(xlUp).Row
.Range("D" & LR + 1).Formula = "=sum(D2:D" & LR & ")"
End With
MsgBox "Completed"
End Sub

For a flexible solution

Sub Demo2()
Dim c As Range
Dim Cols As Long
Dim r As Range
Set r = Worksheets("Raw").Range("A1").CurrentRegion
Cols = r.Columns.Count
r.Copy Worksheets("Sheet1").Range("A1")
Set c = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
With c
.Value = "Total"
.Offset(, Cols-1).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
.Offset(-1).Resize(, Cols).Copy
.PasteSpecial xlPasteFormats
.Resize(, Cols).Font.Bold = True
End With
Application.CutCopyMode = False
MsgBox "Completed"
End Sub

[Veeru]

I Will test it but before that I don't know for some reason my cursor is too big in vba window.

I am attaching the screen shot for the same in Doc file....Can you please tell me the way to again made it normal.

Thanks

[mdmackillop]

Your cursor is in Overwrite mode. Toggle with Insert key

[Veeru]

Hi,

Thanks for the 2 codes but unfortunately both are not meeting my requirement

Ok let me try to explain in better way.

We want to copy A and B col. Data from raw data tab (from A2) and paste in sheet1 in col. A and B only.

Row should be deleted or added as per data in raw data with total in the end.

We will apply formulas in col.D which automatically pick amounts from raw data tab.

So just to remind we only want col. A and Col. B data from raw data tab.


Thanks for your time

[mdmackillop]

Sub Demo2()    Dim c As Range
    Dim Cols As Long
    Dim r As Range
    Set r = Worksheets("Raw").Range("A1").CurrentRegion
    Cols = r.Columns.Count
    r.Copy
    Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteFormats
    r.Resize(, 2).Copy Worksheets("Sheet1").Range("A1")
    Set c = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
    With c
        .Value = "Total"
        .Offset(, Cols - 1).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
        .Offset(-1).Resize(, Cols).Copy
        .PasteSpecial xlPasteFormats
        .Resize(, Cols).Font.Bold = True
    End With
    Application.CutCopyMode = False
    MsgBox "Completed"
End Sub

[Veeru]

HI,

Thanks for revert with another code

But it has not solved my issue yet…we are close, above code is copying and pasting 2 col as we need.

But it also include previous total in rows and then totaling it at the end.

Not sure if more cols making any impact.

Attaching new file (New) , which is little different from above.

We want data from raw data tab only col A and B
Pate in Main tab. It should accommodate new data from raw data above total and retain total at end for col. E and Col. I

Sorry for multiple chain

Thanks

[mdmackillop]

Sub Demo1()
    Dim rwsR, rwsM, x
    rwsR = Sheets("Raw").Columns(1).SpecialCells(2, 1).Count
    rwsM = Sheets("Main").Columns(1).SpecialCells(2, 1).Count
    With Sheets("Main")
        x = rwsR - rwsM
        If x < 0 Then
            .Rows("3:" & 2 - x).Delete
        Else
            .Rows("3:" & 2 + x).Insert
        End If
            Sheets("Raw").Cells(1, 1).CurrentRegion.Resize(, 2).Copy .Range("A2")
    End With
End Sub

[Veeru]

Hi,

Sorry for another one

This perfectly fine…but my data starts from B8 as compare to B1 in Main sheet.so I tried to adjust the code by changing last line reference to A2 to A9 but it is not giving the expected result…should I need to change anything in below

If x < 0 Then
.Rows("3:" & 2 - x).Delete
Else
.Rows("3:" & 2 + x).Insert

[mdmackillop]

Yes, and surely you can work this out.

[Veeru]

Hi,

i ttried to make some changes here and there but not getting the desired result....can you please take a look last time...attaching sheet with name of Hop

[mdmackillop]

Sub Demo1() 
    Dim rwsR, rwsM, x 
    rwsR = Sheets("Raw").Columns(1).SpecialCells(2, 1).Count 
    rwsM = Sheets("Main").Columns(1).SpecialCells(2, 1).Count 
    With Sheets("Main") 
        x = rwsR - rwsM 
        If x < 0 Then 
            .Rows("13:" & 12 - x).Delete 
        Else 
            .Rows("13:" & 12 + x).Insert 
        End If 
        Sheets("Raw").Cells(1, 1).CurrentRegion.Resize(, 2).Copy .Range("A12") 
    End With 
End Sub

or generally

Sub Demo2()
    Dim rwsR, rwsM, x
    Dim RW As Long
    rwsR = Sheets("Raw").Columns(1).SpecialCells(2, 1).Count
    rwsM = Sheets("Main").Columns(1).SpecialCells(2, 1).Count
    RW = Sheets("Main").Columns(1).SpecialCells(2, 1).Row
    With Sheets("Main")
        x = rwsR - rwsM
        If x < 0 Then
            .Rows(RW + 1 & ":" & RW - x).Delete
        Else
            .Rows(RW + 1 & ":" & RW + x).Insert
        End If
        Sheets("Raw").Cells(1, 1).CurrentRegion.Resize(, 2).Copy .Range("A" & RW)
    End With
End Sub

[Veeru]

thanks for looking it again...it is perfectly working but if I am increasing my raw tab data currently 9 rows to 20 rows....it is over writing total in col. B and all other particulars in total row also not changing.....they are static....

[mdmackillop]

Unexpected behaviour; don't know why
Add EntireRow in this line

.Rows(RW + 1 & ":" & RW + x).EntireRow.Insert

[Veeru]

yes great......it is working....thanks a lot.... :-)