I want to create a button that does autofills in multiple worksheets. But it seems I could only do autofill one sheet at a time... Here is the code:
Private Sub CommandButton1_Click()
Sheets("Sheet1").Range(Cells(1, 1), Cells(1, 1)).AutoFill Destination:=Sheets("Sheet1").Range(Cells(1, 1), Cells(2, 1))
Sheets("Sheet2").Range(Cells(1, 1), Cells(1, 1)).AutoFill Destination:=Sheets("Sheet2").Range(Cells(1, 1), Cells(2, 1))
End Sub
Simple at that. If I break it down into two different buttons, they work just fine. I've tried Worksheets().Activate, but it doesn't help. (most people don't recommend activate anyways) Also tried writing Sub but the same problem persist as "error 1004".
You've ran into a common coding error where the Range.Cells property inside the Range object do not have their parent explicitly defined.
Private Sub CommandButton1_Click()
With Sheets("Sheet1")
.Range(.Cells(1, 1), .Cells(1, 1)).AutoFill _
Destination:=.Range(.Cells(1, 1), .Cells(2, 1))
End With
With Sheets("Sheet2")
.Range(.Cells(1, 1), .Cells(1, 1)).AutoFill _
Destination:=.Range(.Cells(1, 1), .Cells(2, 1))
End With
End Sub
Note .Range(.Cells(1, 1), .Cells(1, 1)) and not .Range(Cells(1, 1), Cells(1, 1)). Your original was trying to define a range containing the cells on another worksheet.
The With ... End With statement can make the assignment of the parent worksheet a lot easier and doesn't obfuscate what you are trying to accomplish.
It works when I added Activate:
Sheets("Sheet1").Activate 'added
Sheets("Sheet1").Range(Cells(1, 1), Cells(1, 1)).AutoFill _
Destination:=Sheets("Sheet1").Range(Cells(1, 1), Cells(2, 1))
Sheets("Sheet2").Activate 'added
Sheets("Sheet2").Range(Cells(1, 1), Cells(1, 1)).AutoFill _
Destination:=Sheets("Sheet2").Range(Cells(1, 1), Cells(2, 1))
Related
I am trying to write a macro that takes parts of one sheet and paste values on the next. I know using select isn't ideal. But i Don't know how to do it other wise. In the past i have got a out of range error if i was not selecting the sheet before hand. In the macro i have y defined earlier but I am getting an
1004 application-defined or object-defined error
y = Sheets("sheet1").Range("B1", Range("B2").End(xlDown)).Count
Sheets("Bucket12").Select
Sheets("Bucket12").Range("C2", Range("C2").End(xlDown)).Copy
Sheets("upload").Range(Cells(y, 2)).PasteSpecial xlPasteValues
Sheets("Bucket12").Range("E2", Range("E2").End(xlDown)).Copy
Sheets("upload").Range(Cells(y, 3)).PasteSpecial xlPasteValues
Sheets("Bucket12").Range("G2", Range("G2").End(xlDown)).Copy
Sheets("upload").Range(Cells(y, 5)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
The issue is that Range() expects two arguments - Cell1 and Cell2 - you're only giving it one argument, which is throwing error 1004.
Instead, just use .Cells():
y = Sheets("sheet1").Range("B1", Range("B2").End(xlDown)).Count
Sheets("Bucket12").Select
Sheets("Bucket12").Range("C2", Range("C2").End(xlDown)).Copy
Sheets("upload").Cells(y, 2).PasteSpecial xlPasteValues
Sheets("Bucket12").Range("E2", Range("E2").End(xlDown)).Copy
Sheets("upload").Cells(y, 3).PasteSpecial xlPasteValues
Sheets("Bucket12").Range("G2", Range("G2").End(xlDown)).Copy
Sheets("upload").Cells(y, 5).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Better yet, let's avoid Select, Copy and Paste altogether:
y = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 2).End(xlUp).Row
Dim sht1 As Worksheet, sht2 As Worksheet, lastrow As Long
Set sht1 = ThisWorkbook.Worksheets("Bucket12")
Set sht2 = ThisWorkbook.Worksheets("upload")
lastrow = sht1.Cells(sht1.Rows.Count, 3).End(xlUp).Row
sht2.Range(sht2.Cells(y, 2), sht2.Cells(lastrow + y - 2, 2)).Value = _
sht1.Range(sht1.Cells(2, 3), sht1.Cells(lastrow, 3)).Value
lastrow = sht1.Cells(sht1.Rows.Count, 5).End(xlUp).Row
sht2.Range(sht2.Cells(y, 3), sht2.Cells(lastrow + y - 2, 3)).Value = _
sht1.Range(sht1.Cells(2, 5), sht1.Cells(lastrow, 5)).Value
lastrow = sht1.Cells(sht1.Rows.Count, 7).End(xlUp).Row
sht2.Range(sht2.Cells(y, 5), sht2.Cells(lastrow + y - 2, 5)).Value = _
sht1.Range(sht1.Cells(2, 7), sht1.Cells(lastrow, 7)).Value
As another note - it's better to use xlUp than xlDown when determining your lastrow for data entry.
VBA novice and got 90% of the way to what I need but I just can't figure out the final part. For the last step I have a range of data from A:K, with A containing a unique number. An updated version of this data is pasted below the initial range with the numbers in Column A staying the same, but B:K being updated.
How can i copy the duplicate row below, paste it over the original above, and then delete the duplicate?
Sub TEST2()
'
' TEST2 Macro
'
' Sheets("Sheet1").Select
ActiveSheet.Range("A1:K1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$20").AutoFilter Field:=8, Criteria1:="red"
Range("a2").Select
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:K" & LR).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
ActiveSheet.Range("A1:l100").RemoveDuplicates Columns:=Array(1, 1), Header:=xlYes
End With
Range("$q$1").Select
Selection.Copy
Range("H2:H1000").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("Sheet1").Select
Worksheets("Sheet1").ShowAllData
Range("O3").Select
Sheets("Sheet2").Select
Range("O3").Select
End Sub
At the moment i can only get as far as using this to delete the duplicates. There are other elements to the sheet which require it to be done this way.
Thanks in advance for any help!!
First thought after seeing the issue... it's a little more than a single line:
Dim i as integer, LR as Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 to LR 'Assumes that row 1 is headers
If Application.Match(Cells(i,1),Range(Cells(2,1),Cells(i-1,1)),0)>0 Then
Rows(i).Cut
Rows(Application.Match(Cells(i,1),Range(Cells(2,1),Cells(i-1,1)),0)+1).PasteSpecial xlPasteValues
Else
End If
Next i
Edit: It's not liking the range; I will try cleaning it up, then use insert/delete... keep in mind, if we're using delete for any row, you'll want to reverse the step, as to avoid issues. See below changes, noting that j is added:
Dim i As Integer, j As Integer, LR As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = LR To 3 Step -1 'Assumes that row 1 is headers
If Application.IfError(Application.Match(Cells(i, 1), Range(Cells(2, 1), Cells(i - 1, 1)), 0), 0) > 0 Then
j = Application.Match(Cells(i, 1), Range(Cells(2, 1), Cells(i - 1, 1)), 0)
Range(Cells(i, 1), Cells(i, 11)).Cut
Range(Cells(j + 1, 1), Cells(j + 1, 11)).Insert xlShiftDown
Range(Cells(j + 2, 1), Cells(j + 2, 11)).Delete
End If
Next i
You can use the below algorithm (with illustrated example as below) :-
Create a column to store sequential number for sorting purpose
Perform the sorting so that the latest appended rows are always at the top. Excel's removeduplication function will always keep the first encountered unique value
Once done, you can perform sorting to re-order the rows of data again.
Below is a sample code which you will need to modify based on your actual dataset.
Sub Test()
LastRow = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
Range("L1").Value = LastRow
Range("L2").Value = LastRow - 1
Range("L1:L2").AutoFill Destination:=Range("L1:L" & LastRow)
Range("A1:L" & LastRow).Sort Order1:=xlAscending, Key1:=Range("L1"), Header:=xlNo
Range("A1:L" & LastRow).RemoveDuplicates Columns:=Array(1, 1), Header:=xlNo
End Sub
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
I have a macro that copies some columns from a BD Sheet and pastes in another sheet.
I've got this code working in Excel 2007, but I've encountered an issue Selecting a Sheet, then copy/paste in Excel 2010 and later. It seems the problem is not in my .Select. It appears to be in the PasteSpecial() that automatically selects the with Sheet() and executes other .copy() without going back to de previous sheet (the screen blinks every pasteSpecial) - I don't know if I was clear enough. [sometimes it works fine, especially using debugger]
Code
Const BD_SHEET As String = "Estrategia"
Const PRICE_SHEET As String = "Precos"
Public Sub Execute()
....
actualCalculate = Application.Calculation
Application.Calculation = xlCalculationManual
LoadPrices()
Application.Calculate
Application.Calculation = actualCalculate
End Sub
Private Sub LoadPrices()
Dim lastSheet As Worksheet
Set lastSheet = ActiveSheet
Sheets(BD_SHEET).Select
lastRow = [A1000000].End(xlUp).row
With Sheets(PRICE_SHEET)
Range(Cells(2, 2), Cells(lastRow, 2)).Copy
.[A2].PasteSpecial xlPasteValues '<---- Working
Range(Cells(2, 7), Cells(lastRow, 7)).Copy
.[B2].PasteSpecial xlPasteValues '<---- Working
Range(Cells(2, 9), Cells(lastRow, 10)).Copy '<---- Error!
.[C2].PasteSpecial xlPasteValues
Range(Cells(2, 12), Cells(lastRow, 12)).Copy '<---- Error!
.[E2].PasteSpecial xlPasteValues
End With
lastSheet.Select
End Sub
I can remove .Select and add Set theSheet = Sheets(BD_SHEET) but the code is going to be durty.
Exemple:
...
Set lastSheet = ActiveSheet
Set bdSheet = Sheets(BD_SHEET)
lastRow = [A1000000].End(xlUp).row
With Sheets(PRICE_SHEET)
bdSheet.Range(bdSheet.Cells(2, 2), bdSheet.Cells(lastRow, 2)).Copy
.[A2].PasteSpecial xlPasteValues
End With
...
but the code is going to be durty.
That is because you are doing it the wrong way
Instead of
With Sheets(PRICE_SHEET)
bdSheet.Range(bdSheet.Cells(2, 2), bdSheet.Cells(lastRow, 2)).Copy
.[A2].PasteSpecial xlPasteValues
End With
Do this
With bdSheet
.Range(.Cells(2, 2), .Cells(lastRow, 2)).Copy
Sheets(PRICE_SHEET).[A2].PasteSpecial xlPasteValues '<---- Working
End With
Also never use Hardcoded values to find the last row. You may see This on how to calculate the last row.
Also
Range1.Copy
Range2.PasteSpecial xlPasteValues
can be written as
Range2.Value = Range1.Value
Applying the above, I have re-written your code. Is this what you are trying? (Untested)
Private Sub LoadPrices()
Dim wsCopyFrm As Worksheet, wsCopyTo As Worksheet
Dim rng As Range
Dim lastRow As Long
Set wsCopyFrm = ThisWorkbook.Sheets(BD_SHEET)
Set wsCopyTo = ThisWorkbook.Sheets(PRICE_SHEET)
With wsCopyFrm
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range(.Cells(2, 2), .Cells(lastRow, 2))
wsCopyTo.Range("A2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Set rng = .Range(.Cells(2, 7), .Cells(lastRow, 7))
wsCopyTo.Range("B2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Set rng = .Range(.Cells(2, 9), .Cells(lastRow, 10))
wsCopyTo.Range("C2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Set rng = .Range(.Cells(2, 12), .Cells(lastRow, 12))
wsCopyTo.Range("E2").Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End With
End Sub
I tested each part of my code individually, before running the macro and all parts worked just fine.
The one that fails in my codes is:
SQL.Range(Cells(2, 2), Cells(SQL.UsedRange.Rows.Count, 2)).Copy
The error message is as follows:
Run-time error '1004'
Application-defined or object-defined error
Here is my code up until the point of error. What could be going wrong?
Sub Prep()
Dim BO, HOC, Pol, Adv, Asg, Pay, SQL, Fml, Tbl As Worksheet
Dim c As Integer
Set BO = Sheets("BO")
Set HOC = Sheets("HOC")
Set Pol = Sheets("Policy")
Set Adv = Sheets("Advisor")
Set Asg = Sheets("Assignee")
Set Pay = Sheets("Payer")
Set SQL = Sheets("SQL")
Application.ScreenUpdating = False
BO.Range("L:L").Insert
BO.Range("L2").Value = "=DATE(LEFT(K2,4),MID(K2,5,2),RIGHT(K2,2))"
With BO.Range(Cells(2, 12), Cells(BO.UsedRange.Rows.Count, 12))
.FillDown
.Copy
End With
With BO.Range(Cells(2, 11), Cells(BO.UsedRange.Rows.Count, 11))
.PasteSpecial xlPasteValues
.NumberFormat = "mm/dd/yyyy"
End With
BO.Columns(12).EntireColumn.Delete
BO.Range("M:M").Insert
BO.Range("M2").Value = "=DATE(LEFT(L2,4),MID(L2,5,2),RIGHT(L2,2))"
With BO.Range(Cells(2, 13), Cells(BO.UsedRange.Rows.Count, 13))
.FillDown
.Copy
End With
With BO.Range(Cells(2, 12), Cells(BO.UsedRange.Rows.Count, 12))
.PasteSpecial xlPasteValues
.NumberFormat = "mm/dd/yyyy"
End With
BO.Columns(13).EntireColumn.Delete
BO.Range("N:N").Insert
BO.Range("N2").Value = "=IFERROR(DATE(LEFT(M2,4),MID(M2,5,2),RIGHT(M2,2)),"""")"
With BO.Range(Cells(2, 14), Cells(BO.UsedRange.Rows.Count, 14))
.FillDown
.Copy
End With
With BO.Range(Cells(2, 13), Cells(BO.UsedRange.Rows.Count, 13))
.PasteSpecial xlPasteValues
.NumberFormat = "mm/dd/yyyy"
End With
BO.Columns(14).EntireColumn.Delete
SQL.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
Header:=xlYes
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Formulas"
Set Fml = Sheets("Formulas")
With Fml.Cells(1, 1)
.Value = "=EOMONTH(TODAY(),-1)"
.Copy
.PasteSpecial xlPasteValues
.NumberFormat = "mm/dd/yyyy"
End With
SQL.Range(Cells(2, 2), Cells(SQL.UsedRange.Rows.Count, 2)).Copy
You are trying to define the Range object using two Range.Cells properties from other worksheets.
Define every reference within your definition explicitly.
SQL.Range(SQL.Cells(2, 2), SQL.Cells(SQL.UsedRange.Rows.Count, 2)).Copy
Or a more preferred method,
with SQL
.Range(.Cells(2, 2), .Cells(.UsedRange.Rows.Count, 2)).Copy
end with