I'm new with Macro and I want to create a simple copy and paste excel formula from one sheet to another. But the thing is the main data has a formula inside the cell and it wont let me copy and paste as values it to another cell.
Sub selectpasting()
Dim Lastrow As Long, erow As Long
Lastrow = Sheets("attendance").Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To Lastrow
If Sheets("attendance").Cells(i, 3) = "absent" Then
Sheets("attendance").Cells(i, 1).copy
erow = Sheets("forpasting").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("attendance").Paste Destination:=Sheets("forpasting").Cells(erow, 1)
Sheets("attendance").Cells(i, 3).copy
Sheets("attendance").Paste Destination:=Sheets("forpasting").Cells(erow, 2)
End If
Next i
Application.CutCopyMode = False
Sheets("forpasting").Columns.AutoFit
Range("A1").Select
End Sub
Change this row:
Sheets("attendance").Paste Destination:=Sheets("forpasting").Cells(erow, 1)
To:
Sheets("forpasting").Cells(erow, 1).PasteSpecial xlValues
The complete code would be:
Sub selectpasting()
Dim Lastrow As Long, erow As Long
Dim i As Long
Lastrow = Sheets("attendance").Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To Lastrow
If Sheets("attendance").Cells(i, 3) = "absent" Then
Sheets("attendance").Cells(i, 1).Copy
erow = Sheets("forpasting").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("forpasting").Cells(erow, 1).PasteSpecial xlValues
Sheets("attendance").Cells(i, 3).Copy
Sheets("forpasting").Cells(erow, 2).PasteSpecial xlValues
End If
Next i
Application.CutCopyMode = False
Sheets("forpasting").Columns.AutoFit
Range("A1").Select
End Sub
The code above is quite slow (try both the codes and you would notice that the below is way faster).. The reason is that in the above excel needs to determine/evaluate if the the cell properties needs to be pasted or not due to ".copy". It's one approach when you need to copy/paste cell formats etc.
In your case you only interested in the value the cells shows. So you could just pick the value and copy it.
I would therefore recommend you to change it to:
Sub selectpasting_2()
Dim Lastrow As Long, erow As Long
Dim i As Long
Lastrow = Sheets("attendance").Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To Lastrow
If Sheets("attendance").Cells(i, 3) = "absent" Then
erow = Sheets("forpasting").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheets("forpasting").Cells(erow, 1) = Sheets("attendance").Cells(i, 1)
Sheets("forpasting").Cells(erow, 2) = Sheets("attendance").Cells(i, 3)
End If
Next i
Application.CutCopyMode = False
Sheets("forpasting").Columns.AutoFit
Range("A1").Select
End Sub
Related
Getting runtime error 1004 method paste of object _worksheet failed for below code
Please help, thanks in Advance.
Sub Move()
Dim lastrow As Long, erow As Long
lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lastrow
Sheet1.Cells(i, 1).Copy
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet1.Paste Destination = Worksheets("Sheet2").Cells(erow, 1)
Sheet1.Cells(i, 2).Copy
Sheet1.Paste Destination = Worksheets("Sheet2").Cells(erow, 2)
Sheet1.Cells(i, 3).Copy
Sheet1.Paste Destination = Worksheets("Sheet2").Cells(erow, 3)
Next i
Application.CutCopyMode = False
Sheet2.Columns().AutoFit`
Range("A1").Select
End Sub
Move some thing around and do the whole in one line:
Sub Move()
Dim lastrow As Long, erow As Long
lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet1.Range(Sheet1.Cells(1, 1),Sheet1.Cells(lastrow , 3)).Copy Sheet2.Cells(erow, 1)
Application.CutCopyMode = False
Sheet2.Columns().AutoFit
Range("A1").Select
End Sub
now if that does not work the perhaps the code names are incorrect and one should replace all the Sheet1 and Sheet2 with Worksheets("Sheet1") and Worksheets("Sheet2") respectively.
along the lines of #ScottCraner 's solution, you could manage sheet references with the use of With ...End With block and avoid multiple repetitions:
Sub Move()
With Sheet1 ' reference Sheet1 once and for all...
.Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3).Copy Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) ' all Range objects beginning with dots are referencing the object after `With` keyword (i.e. Sheet1)
End With
Sheet2.Columns.AutoFit
End Sub
BTW, using Destination parameter of Copy method you don't "activate" CutCopyMode, hence no need to set it to False
and should you be interested in copying/pasting values only, then nest another With ...End With block to reference the "source" range:
Sub Move()
With Sheet1 ' reference Sheet1 once and for all...
With .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3) ' reference Sheet1 columns A:C range from row 1 down to column A last not empty cell
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(.Rows.Count, .Columns.Count).Value = .Value ' get Sheet2 range as its column A last not empty cell, resize it as last referenced range and fill it with its values
End With
End With
Sheet2.Columns.AutoFit
End Sub
Trying to populate a sheet with only instances that meet a criteria. Here the criteria is a 1 in the last column of the dataset.
Current code is only pulling the first iteration. Does not go to next i. Next i in the current dataset is an instance that should be pulled so that is not the issue.
Sub Cleaned()
Dim LastRow As Integer, c As Long, i As Integer, erow As Integer
Worksheets("SPData").Activate
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
c = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To 600
If Cells(i, c) = 1 Then
Range(Cells(i, 1), Cells(i, c)).Select
Selection.Copy
Worksheets("CleanedData").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next i
End Sub
Also tried:
Sub Moving()
Dim r As Long, c As Long, i As Integer, erow As Integer
Worksheets("SPData").Activate
r = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
c = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To r
If Cells(i, c) = 1 Then
Range(Cells(i, 1), Cells(i, c)).Select
Selection.Copy
Worksheets("CleanedData").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
End If
Next i
End Sub
Correct me if I am wrong - you want to copy the entire row if the value in the last column is equal to 1?
If so then this code works:
Sub Moving()
Dim r As Long
Dim c As Long
Dim i As Integer
Dim erow As Integer
With Worksheets("SPData")
r = .Cells(.Rows.Count, 2).End(xlUp).Row
c = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 2 To r
If .Cells(i, c) = 1 Then
.Range(.Cells(i, 1), .Cells(i, c)).Copy
With Worksheets("CleanedData")
erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Paste Destination:=.Cells(erow, 1)
End With
End If
Next i
End With
End Sub
I would strongly advise you to avoid using .Select in VBA whenever you can.
Also it is usually much better to refer to the actual sheet rather than using ActiveSheet.
I'm new to the coding and have written the following code to fetch particular data from selected cells after checking a few conditions and putting it into another Excel sheet. It is throwing an
compile error with message object required.
The code is:
Sub test()
Dim LastRow As Integer, i As Integer, erow As Integer, a As Integer, b As
Integer
LastRow = ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If Cells(i, 3) = "Grade" And Cells(i, 4) <> Null Then
Set a = ActiveSheet.Cells(i, 3)
Set b = ActiveSheet.Cells(i, 7)
Union(a, b).Select
Selection.Copy
Workbooks.Open Filename:="C:\Users\413302\Desktop\Test.xlsx"
Worksheets(“Sheet1”).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub
I am trying to create macro to copy data from multiple sheets to single sheet, data which is updated frequently on each sheets and looking to avoid repetition in data copy if every time I run macro.
I have written below code but its throwing runtime error, please help to solve this error, so I can complete my project.
Private Sub CommandButton1_Click()
Dim Lastrow As Long, erow As Long, totalSheets As Long
totalSheets = Worksheets.Count
For i = 1 To totalSheets
If Worksheets(i).Name <> "Summary" Then
Lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
For j = 5 To Lastrow
Worksheets(i).Activate
Worksheets(i).Cells(i, 1).Copy
erow = Summary.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets(i).Paste Destination = Worksheets("Summary").Cells(erow, 2)
Worksheets(i).Cells(i, 2).Copy
Worksheets(i).Paste Destination = Worksheets("Summary").Cells(erow, 3)
Worksheets(i).Cells(i, 11).Copy
Worksheets(i).Paste Destination = Worksheets("Summary").Cells(erow, 4)
Next
End If
Next
i think this is an easy way accomplish your goal:
Option Explicit
Private Sub CommandButton1_Click()
Dim Lastrow As Long, erow As Long, i As Long, j As Long
Dim wsSummary As Worksheet
Set wsSummary = ThisWorkbook.Worksheets("Summary")
For i = 1 To ThisWorkbook.Worksheets.Count
With Worksheets(i)
If .Name <> "Summary" Then
Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
For j = 5 To Lastrow
erow = wsSummary.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'make usre that column A has data.
.Cells(j, 1).Copy wsSummary.Cells(erow, 2) 'Have in mind that the specific copy - paste method also copy formats.
.Cells(j, 2).Copy wsSummary.Cells(erow, 3)
.Cells(j, 11).Copy wsSummary.Cells(erow, 4)
Next
End If
End With
Next
End Sub
I am collating data of different worksheet.
The problem is when copying data into the destination file, all the data are placed into one column.
The code below is a snippet of the part where the problem occurs.
Workbooks.Open (Folderpath & Filename)
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Lastcolumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(Lastrow, Lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close
erow = ThisIsAWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ThisIsAWS.Paste Destination:=ThisIsAWS.Range(Cells(erow, 1), Cells(erow, Lastcolumn))
Filename = Dir
This is how a file would look initially.
After going through the macro, it ends up like this.
When I do it manually where I copy (ctrl + c) and paste (ctrl + v) using the same data, it comes out fine.
For the source file, the data might have been placed in a table, so would this play a role to why it ends up in one column in the destination file?
EDIT: Source picture. I might have found the problem but still in need of a solution. The column B and C are merged together in this picture. Could this be it?
Your macro works fine for me. However, you could try to set the ranges equal using .value rather than .copy:
Dim to_rng as Range
Dim rng_loop as Range
Workbooks.Open (Folderpath & Filename)
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Lastcolumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
Application.DisplayAlerts = False
erow = ThisIsAWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set to_rng = ThisIsAWS.Range(ThisIsAWS.Cells(erow, 1), ThisIsAWS.Cells(erow + Lastrow - 2, Lastcolumn))
to_rng.value = ActiveSheet.range(ActiveSheet.cells(2,1), ActiveSheet.cells(Lastrow, Lastcolumn)).value
For loop1 = Lastcolumn To 1 Step -1
Set rng_loop = ThisIsAWS.Range(ThisIsAWS.Cells(erow, loop1), ThisIsAWS.Cells((erow + Lastrow - 2), loop1))
If WorksheetFunction.CountA(rng_loop) = 0 Then
rng_loop.Delete shift:=xlToLeft
End If
Next loop1
ActiveWorkbook.Close
Filename = Dir
The loop moves backwards (step -1) through each column in the added range and if all cells in the range column are empty (CountA = 0), then it deletes the column by shifting the entire row to the left.
Original data:
Data added to other file:
Closed Too Early
With Workbooks.Open(Folderpath & Filename).ActiveSheet
Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
Lastcolumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
erow = ThisIsAWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Range(.Cells(2, 1), .Cells(Lastrow, Lastcolumn)).Copy _
Destination:=ThisIsAWS.Cells(erow, 1)
.Parent.Close False
End With
Filename = Dir