I have syntax that run smoothly. But, sadly it can't paste value. I've tried :
.PasteSpecial xlPasteValues
.PasteSpecial Paste:=xlPasteValues
This is my syntax...
Sub CopasToPenalty()
Dim LRSrc As Long, LRDest As Long, SrcRng As Range
With Sheets("RAW_DATA_PENALTY")
LRSrc = .Cells(.Rows.Count, 1).End(xlUp).Row
Set SrcRng = .Range("A2:F" & LRSrc)
End With
With Sheets("PENALTY")
LRDest = .Cells(.Rows.Count, 2).End(xlUp).Row
SrcRng.Copy .Cells(LRDest + 1, 2) 'NOT YET PASTE VALUE
End With
End Sub
Thank you.
SrcRng.Copy .Cells(LRDest + 1, 2) This will not paste just values. It will paste formats and other stuff as well.
Try the below.
Way One Using PasteSpecial
SrcRng.Copy
.Cells(LRDest + 1, 2).PasteSpecial xlPasteValues
Way Two Using Resize
Dim destRng As Range
Set destRng = .Cells(LRDest + 1, 2)
destRng.Resize(SrcRng.Rows.Count, SrcRng.Columns.Count).Value = SrcRng.Value
Related
I_m trying to filter datas in a sheet with the autofilter and copy the results to another sheet. This works so far but I need the data starting with column B. I haven't found a solution so far. Hope someone can help me :)
Dim myRange As Range
lZeile = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
MsgBox lZeile
ActiveSheet.Rows("7:7").AutoFilter Field:=12, Criteria1:="x"
On Error Resume Next
Set myRange = Range(Cells(8, 1), Cells(lZeile, 19)).SpecialCells(xlVisible)
On Error GoTo 0
If myRange Is Nothing Then
MsgBox "no cells"
Else
Intersect(Sheets("Sheet1").UsedRange, Sheets("Sheet1").UsedRange.Offset(7)).SpecialCells(xlCellTypeVisible).Copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Cells(1, 1).PasteSpecial xlPasteValues
End If
The following code should give you your desired result - based on the headers for your data-to-copy being in row 7 of sheet 1. Let me know how it goes.
Option Explicit
Sub CopyFilterX()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim CheckRow As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
With ws1.Cells(7, 1).CurrentRegion
.AutoFilter 12, "x"
CheckRow = ws1.Cells(Rows.Count, 2).End(xlUp).Row
If CheckRow = 7 Then
MsgBox "no cells"
.AutoFilter
Exit Sub
End If
.Offset(1, 1).Copy ws2.Cells(1, 1)
.AutoFilter
End With
End Sub
Replace this line:
Set myRange = Range(Cells(8, 1), Cells(lZeile, 19)).SpecialCells(xlVisible)
with this one:
Set myRange = Range(Cells(8, 2), Cells(lZeile, 19)).SpecialCells(xlVisible)
I am trying to write a script that will take data from columns on two different sheets and paste them into a row on a third sheet without overwriting each other.
Private Sub CommandButton1_Click()
Dim InRangex1 As Range
Dim OutRangex1 As Range
Dim i As Long
Set InRangex1 = Sheets("Line 1").Range("L4:L204")
Set OutRangex1 = Sheets("Numeric Plot").Range("B1")
InRangex1.Worksheet.Activate
InRangex1.Select
Selection.Copy
OutRangex1.Worksheet.Activate
OutRangex1.Select
Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=True
Dim InRangex2 As Range
Dim OutRangex2 As Range
Set InRangex2 = Sheets("Line 3").Range("L4:L204")
Set OutRangex2 = Sheets("Numeric Plot").Range("B1").End(xlToRight).Offset(0, 1).Select
InRangex2.Worksheet.Activate
InRangex2.Select
Selection.Copy
OutRangex2.Worksheet.Activate
OutRangex2.Select
Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=True
End Sub
I am getting a 424 "Object required" error when the second half of the script runs. Not sure where the problem is.
Test this code, please. It it simpler, avoids Select, Activate, Copy and Paste and is very fast...
Private Sub CommandButton1_Click()
Dim arr1 As Variant, arr2 As Variant, OutRangex2 As Range
arr1 = Sheets("Line 1").Range("L4:L204").Value
Sheets("Numeric Plot").Range("B1").Resize(1, UBound(arr1, 1)).Value = WorksheetFunction.Transpose(arr1)
arr2 = Sheets("Line 3").Range("L4:L204").Value
Set OutRangex2 = Sheets("Numeric Plot").Range("B1").End(xlToRight).Offset(0, 1)
OutRangex2.Resize(1, UBound(arr2, 1)).Value = WorksheetFunction.Transpose(arr2)
End Sub
I think the duplicates removal should be consider like being object of a new question, according to our rules...
Please test the next code. It works also using arrays and should be very speedy. Please let me know how it works. It could be integrated in the first sub, but I made it from scratch...
Sub removeDuplicate()
Dim arrSort As Variant, lastCol As Long, lastRow As Long, arrSorted As Variant, sh As Worksheet
Set sh = Sheets("Numeric Plot")
lastCol = sh.Cells(1, sh.Cells.Columns.count).End(xlToLeft).column 'last col on the first row
arrSort = sh.Range(sh.Cells(1, 2), sh.Cells(1, lastCol)).Value 'put the row values in an array
'transpose the array in a column after the last one of the rows 1:
sh.Cells(1, lastCol + 1).Resize(UBound(arrSort, 2), 1).Value = WorksheetFunction.Transpose(arrSort)
'remove duplicates with Excel function:
sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(UBound(arrSort, 2), lastCol + 1)).RemoveDuplicates Columns:=1, Header:=xlNo
lastRow = sh.Cells(sh.Cells.Rows.count, lastCol + 1).End(xlUp).row 'Last row after dupplicate elimination
arrSorted = sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(lastRow, lastCol + 1)).Value 'The cleared column pun in an array
sh.Range(sh.Cells(1, 2), sh.Cells(1, lastCol)).Clear 'clearing the data of the first row
sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(lastRow, lastCol + 1)).Clear 'clearing the data of temporary column
Dim finalRng As Range
Set finalRng = sh.Range("B1").Resize(1, UBound(arrSorted))
finalRng.Value = WorksheetFunction.Transpose(arrSorted) 'transpose the fiterred array
'sort the resulted range:
finalRng.Sort Key1:=finalRng, Order1:=xlAscending, Orientation:=xlLeftToRight
End Sub
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
This isn't complex by far but I'm only a novice at excel macros. I've found online and edited this for my use but I know it's so long. The single ranges all refer to the same cell which is just the value of =today(). I know that can be integrated, I just don't know how. The rest copies a row and pastes it over at the bottom of specific rows, one for each employee. I'm sure there are even better ways to do this since the rows being copied are only there for this code and isn't the main data source. But one step at a time. Lol
Sub LastRowDtDataTEST()
Dim wb As Workbook
Dim ws As Worksheet
Dim LastRow As Long
Set wb = ActiveWorkbook
Set ws = ThisWorkbook.Sheets("Buyer Trend Metrics")
ws.Select
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "J").End(xlUp).Row
Range("J" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B61:H61").Copy
LastRow = Cells(Rows.Count, "K").End(xlUp).Row ' get last row with data in column "K"
Range("K" & LastRow + 1).PasteSpecial Paste:=xlPasteValues ' paste values
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "S").End(xlUp).Row
Range("S" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B62:H62").Copy
LastRow = Cells(Rows.Count, "T").End(xlUp).Row
Range("T" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "AB").End(xlUp).Row
Range("AB" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B63:H63").Copy
LastRow = Cells(Rows.Count, "AC").End(xlUp).Row
Range("AC" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "AK").End(xlUp).Row
Range("AK" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B64:H64").Copy
LastRow = Cells(Rows.Count, "AL").End(xlUp).Row
Range("AL" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "AT").End(xlUp).Row
Range("AT" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B65:H65").Copy
LastRow = Cells(Rows.Count, "AU").End(xlUp).Row
Range("AU" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "BC").End(xlUp).Row
Range("BC" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B66:H66").Copy
LastRow = Cells(Rows.Count, "BD").End(xlUp).Row
Range("BD" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "BL").End(xlUp).Row
Range("BL" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B67:H67").Copy
LastRow = Cells(Rows.Count, "BM").End(xlUp).Row
Range("BM" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "BU").End(xlUp).Row
Range("BU" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B68:H68").Copy
LastRow = Cells(Rows.Count, "BV").End(xlUp).Row
Range("BV" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "CD").End(xlUp).Row
Range("CD" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B69:H69").Copy
LastRow = Cells(Rows.Count, "CE").End(xlUp).Row
Range("CE" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B58").Copy ' Copies the value of =Today() from a cell. Would be easier to just integrate today's date instead.
LastRow = Cells(Rows.Count, "CM").End(xlUp).Row
Range("CM" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
Range("B70:H70").Copy
LastRow = Cells(Rows.Count, "CN").End(xlUp).Row
Range("CN" & LastRow + 1).PasteSpecial Paste:=xlPasteValues
End Sub
Here are some things for you to look at...
ALWAYS use Option Explicit. See here for an explanation.
When you're performing an action such as copying data, it's extremely helpful to be very clear in defining the source and destination of the data. This includes defining which Workbook the data is going to. You'll thank me later for building this habit now.
As an example:
Dim srcWB As Workbook
Dim dstWB As Workbook
Set srcWB = ThisWorkbook
Set dstWB = ThisWorkbook
Dim srcWS As Worksheet
Dim dstWS As Worksheet
Set srcWS = srcWB.Sheets("Sheet1") ' <--- you didn't specify this in your code
Set dstWS = dstWB.Sheets("Buyer Trend Metrics")
When you're performing the same (or very similar) actions over and over, it's the perfect situation to create a separate function that will perform the action for you. When you break out this section of code, it's called "functional isolation". This means that if you have a problem to fix, you only have to fix it in one place instead of finding all the different spots in your code that do the same thing.
In your case, you are performing a copy from one range of cells to another range of cells. So breaking that out into a separate routine looks like this:
Private Sub CopyMyData(ByRef fromData As Range, ByRef toData As Range)
Dim lastrow As Long
With toData.Parent
lastrow = .Cells(.Rows.Count, toData.Column).End(xlUp).Row
End With
fromData.Copy
toData.Cells(lastrow).PasteSpecial Paste:=xlPasteValues
End Sub
Notice here how I'm using variable names that describe what the code does (fromData and toData). This makes it clear what's happening.
Put it all together and your code will look something like this:
Option Explicit
Public Sub StartCopying()
Dim srcWB As Workbook
Dim dstWB As Workbook
Set srcWB = ThisWorkbook
Set dstWB = ThisWorkbook
Dim srcWS As Worksheet
Dim dstWS As Worksheet
Set srcWS = srcWB.Sheets("Sheet1") ' <--- you didn't specify this in your code
Set dstWS = dstWB.Sheets("Buyer Trend Metrics")
CopyMyData fromData:=srcWS.Range("B58"), toData:=dstWS.Range("J:J")
CopyMyData fromData:=srcWS.Range("B61:H61"), toData:=dstWS.Range("K:K")
CopyMyData fromData:=srcWS.Range("B58"), toData:=dstWS.Range("S:S")
CopyMyData fromData:=srcWS.Range("B61:H62"), toData:=dstWS.Range("T:T")
End Sub
Private Sub CopyMyData(ByRef fromData As Range, ByRef toData As Range)
Dim lastrow As Long
With toData.Parent
lastrow = .Cells(.Rows.Count, toData.Column).End(xlUp).Row
End With
fromData.Copy
toData.Cells(lastrow).PasteSpecial Paste:=xlPasteValues
End Sub
There's a pattern to how you're copying/pasting.
Copying every row, pasting to every 9th column after column 10.
I've added two lines for finding the last row - either find it once and paste everything to that row, of find it before you copy each time. Uncomment whichever you prefer.
This will copy B61:H61 to K:P on the last row (with date in J), then B62:H62 to T:Z with the date in R.
The date will also appear correctly formatted rather than as a number.
Public Sub WhateverYouWantToCallIt()
Dim x As Long, y As Long
Dim lLastRow As Long
With ThisWorkbook.Worksheets("Buyer Trend Metrics")
'This will set the same last row for each copy.
lLastRow = .Cells(.Rows.Count, 10).End(xlUp).Row + 1
y = 10
For x = 61 To 70
'This will set the last row on each set of data.
'lLastRow = .Cells(.Rows.Count, y).End(xlUp).Row + 1
.Cells(lLastRow, y) = Date
.Range(.Cells(lLastRow, y + 1), .Cells(lLastRow, y + 7)) = _
.Range(.Cells(x, 2), .Cells(x, 8)).Value
'-OR-
'.Range(.Cells(x, 2), .Cells(x, 8)).Copy
'.Cells(lLastRow, y + 1).PasteSpecial Paste:=xlPasteValues
y = y + 9
Next x
End With
End Sub
Do not double space every single line. You should use these as strategic separators, not the standard. This isn't MLA.
Use a worksheet variable to quickly refer to your sheets (ws refers to the sheet that has the cells to be copied and ds (destination sheet) refers to the sheet where the cells are to be pasted
You can use a value transfer instead of a copy/paste which does not require multiple lines as well
In general, when shortening code, you want to look for repetitiveness. I can see that you are constantly copying the value from Range("B58") so you can also shorten this. You have comments saying you want the value to just be today so you can just do something like
ds.Range("?") = Today Repeat as needed
Option Explicit
Sub LastRowDtData()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim ds As Worksheet: Set ds = ThisWorkbook.Sheets("Buyer Trend Metrics")
Dim LR As Long
LR = ds.Range("J" & ds.Rows.Count).End(xlUp).Offset(1)
ds.Range("J" & LR).Value = ws.Range("B58").Value
LR = ds.Range("K" & ds.Rows.Count).End(xlUp).Offset(1)
ds.Range("K" & LR).Resize(1, 7).Value = ws.Range("B61:H61")
LR = ds.Range("S" & ds.Rows.Count).End(xlUp).Offset(1)
ds.Range("S" & LR).Value = ws.Range("B58").Value
'Repeat for below ranges
'------------------
Range("B62:H62").Copy
Range("B58").Copy
Range("B63:H63").Copy
Range("B58").Copy
Range("B64:H64").Copy
Range("B58").Copy
Range("B65:H65").Copy
Range("B58").Copy
Range("B66:H66").Copy
Range("B58").Copy
Range("B67:H67").Copy
Range("B58").Copy
Range("B68:H68").Copy
Range("B58").Copy
Range("B69:H69").Copy
Range("B58").Copy
Range("B70:H70").Copy
End Sub
My script looks up the highest values in dailySht and pastes the values into a separate sheet recordSht, which usually works fine, but I sometimes get the error Object variable or With block variable not set. Below is the part of the code that returns the error.
Sub DailyBH()
Dim dailySht As Worksheet 'worksheet storing latest store activity
Dim recordSht As Worksheet 'worksheet to store the highest period of each day
Dim lColDaily As Integer ' Last column of data in the store activity sheet
Dim lCol As Integer ' Last column of data in the record sheet
Dim maxCustomerRng2 As Range ' Cell containing the highest number of customers
Dim maxCustomerCnt As Double ' value of highest customer count
Set dailySht = ThisWorkbook.Sheets("hourly KPI")
Set recordSht = ThisWorkbook.Sheets("#BH KPI")
With recordSht
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
With dailySht
lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column
maxCustomerCnt = Round(Application.Max(.Range(.Cells(58, 1), .Cells(58, lColDaily))), 2)
Set maxCustomerRng2 = .Range(.Cells(58, 1), .Cells(58, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues)
.Cells(4, maxCustomerRng2.Column).Copy
recordSht.Cells(4, lCol + 1).PasteSpecial xlPasteValues
recordSht.Cells(4, lCol + 1).PasteSpecial xlPasteFormats
.Cells(22, maxCustomerRng2.Column).Copy
recordSht.Cells(22, lCol + 1).PasteSpecial xlPasteValues
recordSht.Cells(22, lCol + 1).PasteSpecial xlPasteFormats
.Cells(40, maxCustomerRng2.Column).Copy
recordSht.Cells(40, lCol + 1).PasteSpecial xlPasteValues
recordSht.Cells(40, lCol + 1).PasteSpecial xlPasteFormats
.Cells(49, maxCustomerRng2.Column).Copy
recordSht.Cells(49, lCol + 1).PasteSpecial xlPasteValues
recordSht.Cells(49, lCol + 1).PasteSpecial xlPasteFormats
.Cells(58, maxCustomerRng2.Column).Copy
recordSht.Cells(58, lCol + 1).PasteSpecial xlPasteValues
recordSht.Cells(58, lCol + 1).PasteSpecial xlPasteFormats
End With
Set maxCustomerRng = Nothing
Set dailySht = Nothing
Set recordSht = Nothing
End Sub
Can someone please help me figure out that the problem is, as the code works (copies and pastes the correct values) on some cells and not others.
I recommend to use Match instead of Find and use the result of Max directly without converting it into Double to avoid floating point inaccuracies.
With dailySht
lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column
Dim SearchRange As Range
Set SearchRange = .Range(.Cells(58, 1), .Cells(58, lColDaily))
Dim MaxCol As Long
On Error Resume Next 'next line throws error if nothing matched
MaxCol = Application.WorksheetFunction.Match(Application.WorksheetFunction.Max(SearchRange), SearchRange, 0)
On Error GoTo 0 're-enable error reporting !!!
If MaxCol = 0 Then
'nothing was found
Exit Sub
End If
.Cells(4, MaxCol).Copy
'your stuff here