This is part of my script, easy loop copying some rows from one sheet to another:
a = 3
With Sheets("ATD")
Do While .Range("A" & a) <> ""
If .Cells(a, 6).Value = "x" And .Cells(a, 8).Value = "y" Then
.Range(Cells(a, 1), Cells(a, 10)).Copy
Sheets("ART").Range("A" & Sheets("ART").Range("A" & Rows.Count).End(xlUp).row + 1).PasteSpecial xlPasteValues
End If
a = a + 1
Loop
End With
It fails almost every time on .Range(Cells(a, 1), Cells(a, 10)).Copy line (Run-time error '1004': Application-defined or object-defined error). When I add .Select command like this:
a = 3
With Sheets("ATD")
Do While .Range("A" & a) <> ""
If .Cells(a, 6).Value = "x" And .Cells(a, 8).Value = "y" Then
.Select
.Range(Cells(a, 1), Cells(a, 10)).Copy
Sheets("ART").Range("A" & Sheets("ART").Range("A" & Rows.Count).End(xlUp).row + 1).PasteSpecial xlPasteValues
End If
a = a + 1
Loop
End With
everything works fine.
I know I can change .Copy on something like
Sheets("ATD").Range(Cells(a, 1), Cells(a, 10)).Value = Sheets("ART").Range(Cells(b, 1), Cells(b, 10)).Value
but I have another question. If .Copy function require, that cells I want to copy are in currently selected sheet, or am I missing something here?
Can you try with:
.Range(.Cells(a, 1), .Cells(a, 10)).Copy
The points are really important, as they reference the current Cells with the Sheet Object set in the With Sheets("ATD") line.
Related
Here is my code:
For j = 3 To 37 Step 2
If PaddleBDateInstalledTextBox.Value = Cells(j, 8).Value Then
Cells(j, 8).Copy
Range("D42").PasteSpecial Paste:=xlPasteValues
Range("D42").PasteSpecial Paste:=xlPasteFormats
Range("D42").PasteSpecial Paste:=xlPasteAllUsingSourceTheme '<--
cells background, etc.
Range("D42").NumberFormat = "MM/DD/YY"
Cells(j, 8).Clear
End If
Next
I have one cell where the format is a date and I am trying to copy it first and then paste it into another cell but my cell did not have the value pasted in it and the original cell; and the contents were not cleared.
I have another cell that has the format Today() and I want to just copy the value without the formula into another cell but i have failed as well.
The last cell that I want to copy has a formula of =($I$2-H2)+(G2-F2) and I have the same problem.
This code worked for me:
If 1 = Cells(1, 1).Value Then 'Assuming in Cell(1, 1) is the value 1
Cells(1, 1).Copy
Range("B1").PasteSpecial Paste:=xlPasteValues
Range("B1").PasteSpecial Paste:=xlPasteFormats
Range("B1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Range("B1").NumberFormat = "MM/DD/YY"
Cells(1, 1).Clear
End If
Maybe the Cells(j, 8).Value is your problem. What value does j have? If j is a variable your code should be right, but if you mean J as column name the code should be Range("J" & 8).Value or Cells(8, "J").Value instead of Cells(j, 8).Value
This question already has answers here:
Copy Paste Values only( xlPasteValues )
(7 answers)
Closed 4 years ago.
I have code that works perfectly except for I can not seem to paste only values of the copied cell. How would I tell this code to only paste values and not merely copy and paste the cell. I have tried Google, Stack etc with no luck every variation of paste special I try fails! Thanks!
Sheets("AAAA").Select
Dim LR As Long, i As Long
With Sheets("AAAA")
LR = .Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To LR
With .Range("G" & i)
If .Cells.Value = "NO MATCH" Then
With Sheets("BBBB")
ActiveSheet.Cells(i, 1).Copy .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
ActiveSheet.Cells(i, 2).Copy .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0)
ActiveSheet.Cells(i, 3).Copy .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0)
ActiveSheet.Cells(i, 4).Copy .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0)
ActiveSheet.Cells(i, 5).Copy .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0)
ActiveSheet.Cells(i, 7).Copy .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0)
ActiveSheet.Cells(i, 8).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
End If
End With
Next i
End With
Be careful with nested With statements. Maybe fully qualify the second sheet in the inner With.
That said, you can remove the copy altogether and swop it round into an assignment using .Text property of range (cell) to give value only e.g.
.Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0) = ActiveSheet.Cells(i, 1).Text
Better still use .Value2
.Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0) = ActiveSheet.Cells(i, 1).Value2
It preserves more formats and is more resilient.
Private Sub CommandButton1_Click()
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1) = "Wheat" Then
Range(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Select
Selection.Copy
Workbooks.Open Filename:="C:\commodities\allcommodities-new.xlsm"
Worksheets("Sheet2").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 51).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next i
For i = 2 To LastRow
If Cells(i, 1) = "Feeder Cattle" Then
Range(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Select
Selection.Copy
Workbooks.Open Filename:="C:\commodities\allcommodities-new.xlsm"
Worksheets("Sheet2").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 3).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next i
For i = 2 To LastRow
If Cells(i, 1) = "Corn" Then
Range(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Select
Selection.Copy
Workbooks.Open Filename:="C:\commodities\allcommodities-new.xlsm"
Worksheets("Sheet2").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 67).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next i
end sub
NOTE: The code fails at the first "Range" command with a "compile error,
wrong number of arguments, or invalid property assignment" I can get the code to run with 2 cells definitions in the Range command.
While you can state range("B1, C1, D1") you cannot state range("B1", "C1", "D1") which is what you are trying to do.
If you actually want columns 2, 3 and 4 on row i then just use the first and the last like range("B1:D1")
Range(Cells(i, 2), Cells(i, 4)).Select
If the actual columns are a discontiguous group then use Union.
dim rng as range
set rng = union(Cells(i, 2), Cells(i, 4), Cells(i, 6))
rng.select
Please look into How to avoid using Select in Excel VBA macros.
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long, lastRow As Long, nextRow As Long
Dim wbACN As Workbook
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set wbACN = Workbooks.Open(Filename:="C:\commodities\allcommodities-new.xlsm")
For i = 2 To lastRow
Select Case LCase(Cells(i, 1).Value2)
Case "wheat"
Union(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Copy _
Destination:=wbACN.Worksheets("Sheet2").Cells(Rows.Count, "AY").End(xlUp).Offset(1, 0)
Case "feeder cattle"
Union(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Copy _
Destination:=wbACN.Worksheets("Sheet2").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
Case "corn"
Union(Cells(i, 2), Cells(i, 3), Cells(i, 4)).Copy _
Destination:=wbACN.Worksheets("Sheet2").Cells(Rows.Count, "BO").End(xlUp).Offset(1, 0)
Case Else
'do notbhing
End Select
Next i
wbACN.Close savechanges:=True
End Sub
The following script selects a range of data on one sheet and transfers the selection to another sheet.
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow
If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
Range(Cells(i, 1), Cells(i, 4)).Select
Selection.Copy
erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
If Cells(i, 1) <> "" Then Cells(i, 22).Value = "Yes"
If Cells(i, 22) <> "" Then Cells(i, 23).Value = Now
If Cells(i, 23) <> "" Then Cells(i, 24).Value = Environ("UserName")
ActiveWorkbook.Save
End If
Next i
I would now like to introduce a script which will replace the row of data on the target sheet if the value in column A already exists, but i'm not sure how to achieve this, any help is much appreciated.
Thank you in advance.
Public Function IsIn(li, Val) As Boolean
IsIn = False
Dim c
For Each c In li
If c = Val Then
IsIn = True
Exit Function
End If
Next c
End Function
dim a: a= range(destWB.sheet(whatever)..range("A1"),destWB.Range("A" & destWB.sheet(whatever).Rows.Count).End(xlUp)).value
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow
if isin(a, Cells(i, 1) ) then
do whatever you want
else
If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
Range(Cells(i, 1), Cells(i, 4)).Select
Selection.Copy
erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
If Cells(i, 1) <> "" Then Cells(i, 22).Value = "Yes"
If Cells(i, 22) <> "" Then Cells(i, 23).Value = Now
If Cells(i, 23) <> "" Then Cells(i, 24).Value = Environ("UserName")
ActiveWorkbook.save
End If
End If
Next i
I suggest using a Dictionary-Object which is most likely a Hash-Map. The advantage is that you can use the built in method Dictionary.Exists(Key) to check if the Dictionary already holds the specified value (Key).
Also you should not save the Workbook in every step of the iteration. It would be better (and faster) to only save the workbook after completing the copying of your whole data.
Additionally your If-Tests after copy-paste are not neccessary, because you are already checking for Cells(i,1)<>"" before copying so you don't have to check this again as it does not change.
The following code shows how to get your desired result:
Set dict = CreateObject("Scripting.Dictionary")
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To LastRow
If Cells(i, 1) <> "" And Cells(i, 21) = "OK" And Cells(i, 22) <> "Yes" Then
If dict.Exists(Cells(i,1).Value) Then
'value already exists -> update row number
dict.Item(Cells(i,1).Value)=i
Else
'save value of column A and row number in dictionary
dict.Add Cells(i,1).Value, i
End If
Cells(i, 22).Value = "Yes"
Cells(i, 23).Value = Now
Cells(i, 24).Value = Environ("UserName")
End If
Next i
'finally copy over your data (only unique values)
For Each i In dict.Items
Range(Cells(i, 1), Cells(i, 4)).Select
Selection.Copy
erow = Worksheets("iForms").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("iForms").Cells(erow, 1).PasteSpecial Paste:=xlPasteValues
Next i
I am learning visual basic and this script I'm using is coming up with an error when I am initializing the variable i.
I'm not sure what the problem is but I am getting the error message:
Run-time error '1004': Application-defined or object-defined error
Here is my code:
Sub excelmacro()
Sheets("Sheet1").Select
Range("A1").Select
Sheets("Sheet2").Select
Range("B1").Select
i = 1
While i <> 10
If Len(ActiveCell.Value) > 1 Then
Sheets("Sheet1").Select
xname = Right(ActiveCell.Value, Len(ActiveCell.Value) - 6)
xsalary = Right(ActiveCell.Value, Len(ActiveCell.Offset(2, 0).Value) - 8)
xdesignation = Right(ActiveCell.Value, Len(ActiveCell.Offset(1, 0).Value) - 13)
Sheets("Sheet2").Select
ActiveCell.Value = xname
ActiveCell.Offset(0, 1).Value = xdesig
ActiveCell.Offset(0, 3).Value = xsalary
ActiveCell.Offset(1, 0).Select
Sheets("Sheet1").Select
ActiveCell.Offset(3, 0).Select
Else
i = 10
End If
Wend
End Sub
you do not need the variable i in your code anyway! just kick the line initializing i out.
The if statement in your loop that uses i is basically to escape the loop and can be shortened to:
While Len(ActiveCell.Value) > 1
Sheets("Sheet1").Select
xname = Right(ActiveCell.Value, Len(ActiveCell.Value) - 6)
xsalary = Right(ActiveCell.Value, Len(ActiveCell.Offset(2, 0).Value) - 8)
xdesignation = Right(ActiveCell.Value, Len(ActiveCell.Offset(1, 0).Value) - 13)
Sheets("Sheet2").Select
ActiveCell.Value = xname
ActiveCell.Offset(0, 1).Value = xdesig
ActiveCell.Offset(0, 3).Value = xsalary
ActiveCell.Offset(1, 0).Select
Sheets("Sheet1").Select
ActiveCell.Offset(3, 0).Select
Wend
This may be a good time to start practising the methods detailed in How to avoid using Select in Excel VBA macros.
Your code is repeatedly retrieving different lengths of the right-most characters from ActiveCell but using the length of the values from rows below the active cell to determine how many characters to retrieve. It seems that you should be retrieving the characters from the same cell that you are using to determine the length.
Sub excelmacro()
Dim i As Long, xname As String, xsalary As String, xdesignation As String
With Sheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Step 3
If CBool(Len(.Cells(i, "A").Value)) Then
xname = Right(.Cells(i, "A").Value, Len(.Cells(i, "A").Value) - 6)
xdesignation = Right(.Cells(i + 1, "A").Value, Len(.Cells(i + 1, "A").Value) - 13)
xsalary = Right(.Cells(i + 2, "A").Value, Len(.Cells(i + 2, "A").Value) - 8)
With Sheets("Sheet2")
.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = xname
.Cells(Rows.Count, "B").End(xlUp).Offset(0, 1) = xdesignation
.Cells(Rows.Count, "B").End(xlUp).Offset(0, 3) = xsalary
End With
End If
Next i
End With
End Sub
I've retained your use of a string variable for the salary although you may be better served by using a variable of type double and converting the text with a CDbl() wrapper. The second use of xdesig instead of xdesignation was corrrected.