PDA

View Full Version : [SOLVED] Code for copy and pasting in excel



Veeru
07-25-2017, 12:49 PM
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 :-


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


Thanks for your guidance as always

mdmackillop
07-25-2017, 02:55 PM
Try doing it yourself using the Macro recorder. Let us know if you have any problems.

Veeru
07-26-2017, 04:15 AM
Hi,

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

Currently if I am selecting a range A1:D6 then it will work fine but next time when my range changes let’s say A1:D10 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
07-26-2017, 04:15 AM
I have already attached one work book named "Net". thanks

Veeru
07-26-2017, 04:30 AM
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
07-26-2017, 08:58 AM
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
07-26-2017, 10:09 AM
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
07-26-2017, 11:04 AM
Your cursor is in Overwrite mode. Toggle with Insert key

Veeru
07-26-2017, 11:32 AM
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
07-26-2017, 11:50 AM
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
07-27-2017, 06:55 AM
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
07-27-2017, 07:32 AM
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
07-27-2017, 12:06 PM
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
07-28-2017, 03:14 AM
Yes, and surely you can work this out.

Veeru
07-28-2017, 06:09 AM
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
07-28-2017, 06:31 AM
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
07-28-2017, 07:10 AM
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
07-28-2017, 07:35 AM
Unexpected behaviour; don't know why
Add EntireRow in this line

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

Veeru
07-30-2017, 01:20 AM
yes great......it is working....thanks a lot.... :-)