I'm so close, but this isn't working quite yet.
What's wrong here?
Sub DUMMY_ITEMS()
'
' DUMMY_ITEMS Macro
Sheets("Operations").Select
Range("H2:V73").Select
Selection.Copy
Sheets("Raw Data").Select
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub '
I guess you mean you got an error trying to use the PasteSpecial line.
As a recommendation, try to avoid using Select, Selection, and ActiveSheet, instead use fully qualified Worksheets and Ranges.
"Reduced" Code
Sub DUMMY_ITEMS()
'
' DUMMY_ITEMS Macro
Dim LastRow As Long
Sheets("Operations").Range("H2:V73").Copy
With Sheets("Raw Data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & LastRow + 1).PasteSpecial xlPasteValues
End With
End Sub
Related
I am very new to macro . Iam using this code for concatenating two column values into one column. This code today failed , for 10 first rows of the sheet , and it worked for the rest of the rows.Why happened like this , i havent changed anything at all !
Thanks.
Sub FixCrossSell()
Dim wb As Workbook
Dim lr As Long
Set wb = ThisWorkbook
wb.Worksheets("CrossSell").Activate
Cells(2, 1).Value = "=B2&E2"
lr = Cells(Rows.Count, 2).End(xlUp).Row
Range("A2").Select
Selection.Copy
Range("A3:A" & lr).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.Calculate
Range("A2:A" & lr).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Try this:
Sub FiXCrossSell()
Dim lr As Long
With Worksheets("CrossSell")
lr = .Cells(Rows.Count, 2).End(xlUp).Row
With .Range("A2:A" & lr)
.FormulaR1C1 = "=rc2&rc5"
.Value = .Value
End With
End With
End Sub
Probably just count the cells in column B, then place the Formula in Column A
Sub Button1_Click()
Dim LstRw As Long, Rng As Range, Sh As Worksheet
Set Sh = Sheets("CrossSell")
With Sh
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
Set Rng = .Range("A2:A" & LstRw)
Rng = "=B2&E2"
End With
End Sub
Ah.. I see someone else answered this while I was thinking about it.
I need your help on something.. I have the 1004 error message (application or object non defined) when running the following code (I put only the critical parts) :
Sub overwrite_CDL()
Dim sht As Worksheet, LastRow As Long
Set sht = ThisWorkbook.Worksheets("JDE_Greece")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
sht.Activate
Range("M1").AutoFilter Field:=13, Criteria1:="#N/A"
Range("A1:P" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Mismatches").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'we want to create a summary sheet with the matches and the N/A:'
sht.Range("M1").AutoFilter Field:=13, Criteria1:="<>#N/A"
sht.Range("A1:P" & LastRow).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Worksheets.Add(After:=Worksheets("Instructions")).Name = "Summary DRP"
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Separately, everything works fine (no error messages, good output) but gives me the error 1004 when running together. The sheet I want to add is no created ("Summary DRP") even if the filters are set correctly.
I think the issue is related to the Selection / Copy but I don't know exactly why (I guess something is not defined properly..).
Can someone help me ? Thanks in advance :)
A few things....
Your code is hard to read without indents (that won't cause an error though).
You set your last row on the currently active sheet, which may not be "JDE_Greece".
After finding the last row, then you activate JDE_Greece.
You copy the selection.
You change sheets.
You paste into whatever cells are selected on the Mismatches sheet (K36:Z36 on my sheet).
You try and select the filtered to <>#N/A cells, but you haven't reselected the sheet yet so it can't select the cells and throws a Select Method of Range class failed error.
The moral of this story.... don't use Select.
So your code with nothing removed, but updated with comments:
Sub overwrite_CDL()
Dim sht As Worksheet, LastRow As Long
Dim sht1 As Worksheet, sht2 As Worksheet '\\New variables
Set sht = ThisWorkbook.Worksheets("JDE_Greece")
Set sht1 = ThisWorkbook.Worksheets("Mismatches") '\\Added reference to Mismatches.
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row '\\Add sheet reference (not really necessary on Rows.Count as row counts should be the same across sheets).
'sht.Activate '\\Don't need to Activate or Select.
sht.Range("M1").AutoFilter Field:=13, Criteria1:="#N/A" '\\Add sheet reference.
sht.Range("A1:P" & LastRow).SpecialCells(xlCellTypeVisible).Copy '\\No need to Select, just copy.
'Selection.Copy '\\Don't need this as incorported into above line.
'Sheets("Mismatches").Select
sht1.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False '\\Added sheet and cell reference.
Application.CutCopyMode = False
'we want to create a summary sheet with the matches and the N/A:'
'\\Moved these two lines after the new sheet is created.
'\\sht.Range("M1").AutoFilter Field:=13, Criteria1:="<>#N/A"
'\\sht.Range("A1:P" & LastRow).SpecialCells(xlCellTypeVisible).Select
'Selection.Copy '\\Don't need this as incorported into above line.
Set sht2 = ThisWorkbook.Worksheets.Add 'Add worksheet and use variable to reference it.
sht2.Name = "Summary DRP"
sht2.Move After:=ThisWorkbook.Worksheets("Instructions")
'Worksheets.Add(After:=Worksheets("Instructions")).Name = "Summary DRP" '\\This row is now the above 3 rows.
sht.Range("M1").AutoFilter Field:=13, Criteria1:="<>#N/A"
sht.Range("A1:P" & LastRow).SpecialCells(xlCellTypeVisible).Copy '\\No need to Select, just copy.
sht2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False '\\Added sheet and cell reference.
End Sub
And tidied up:
NB: I've removed the extra arguments you entered in the PasteSpecial - these are default values, so get set as that anyway.
Your code will still fail if 'Summary DRP' already exists.
Sub overwrite_CDL()
Dim sht As Worksheet, LastRow As Long
Dim sht1 As Worksheet, sht2 As Worksheet
Set sht = ThisWorkbook.Worksheets("JDE_Greece")
Set sht1 = ThisWorkbook.Worksheets("Mismatches")
With sht
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("M1").AutoFilter Field:=13, Criteria1:="#N/A"
.Range("A1:P" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With
sht1.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Set sht2 = ThisWorkbook.Worksheets.Add
With sht2
.Name = "Summary DRP"
.Move After:=ThisWorkbook.Worksheets("Instructions")
End With
With sht
.Range("M1").AutoFilter Field:=13, Criteria1:="<>#N/A"
.Range("A1:P" & LastRow).SpecialCells(xlCellTypeVisible).Copy
End With
sht2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub
This code is a bit complex but the problem with it is the second and third time it is run it will start to lose columns on the "Base434" worksheet that it pulls information from. I tried a quick fix of adding "Range("A1").Select so that anything previously highlighted couldn't throw it off but it keeps ditching the 20th row which is column "T". I have left all of the code below in hope that someone can find my bug. I just cannot sort it.
Essentially this code sorts set fields of data on an imported worksheet called "Base434", copies specific fields to another page which has some embeded formulas then checks to see if the worksheet "NoStdHC" exists. If it doesn't it will create said worksheet and add the header. Then move to the filtered worksheet called "Base434" and copy all visible cells in that worksheet. It will then paste those in the first available cell in column A of "NoStdHC". My issue is after running this once it refuses to copy the final column on the next "Base434" sheet that has been imported. Can anyone find the fault in my code? Yes I know a lot of this could be condensed if I were better at coding but I would prefer to understand what the code is doing which is why I have it written this way.
Sub NoStdHC()
'
' NoStdHC Macro created by
'
'
Application.ScreenUpdating = False
Sheets("Base434").Select
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=15
ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10
ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5", _
Operator:=xlAnd
Columns(11).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Processing").Select
Range("AC1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTA(C[26])"
Range("e5").Select
ActiveCell.FormulaR1C1 = "=SUM(C[24])"
Range("C8").Select
Sheets("Base434").Select
Dim wsTest As Worksheet
Const strSheetName As String = "PR0OnStd"
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
Worksheets.Add.Name = strSheetName
Sheets("Base434").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("PR0OnStd").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Columns.AutoFit
Range("A2").Select
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
End If
Sheets("Base434").Select
Range("a1").Select
Columns(1).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("PR0OnStd").Select
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = True
End Sub'
As commented by #A.S.H avoid using Select/Activate/ActiveCell if at all possible. Ranges should be qualified by using their sheet names. With...End With constructs achieve both of these goals. The With statement allows you to perform a series of statements on a specified object without requalifying the name of the object.
Indentation makes code much easier to read and understand.
With the foregoing in mind I think this code is understandable
Sub NoStdHC()
Dim LastRow As Long
Dim sht As Worksheet
Application.ScreenUpdating = False
With Sheets("Base434")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
.Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5"
.Range(.Cells(2, 11), .Cells(LastRow, 11)).Copy
End With
With Sheets("Processing")
.Range("AC1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Range("C5").FormulaR1C1 = "=COUNTA(C[26])"
.Range("E5").FormulaR1C1 = "=SUM(C[24])"
End With
Dim wsTest As Worksheet
Const strSheetName As String = "PR0OnStd"
'Loop through sheets to find strSheetName
'if not found, then wsTest will be Nothing
For Each sht In ThisWorkbook.Sheets
If sht.Name = strSheetName Then
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
Exit For
End If
Next
If wsTest Is Nothing Then
'Add the sheet, set up headings, column widths and frozen pane
Worksheets.Add.Name = strSheetName
With Sheets("Base434")
.Range("A1", .Range("A1").End(xlToRight)).Copy
End With
With Sheets("PR0OnStd")
.Range("A1").PasteSpecial xlPasteValues
.UsedRange.Columns.AutoFit
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
End If
With Sheets("Base434")
.Range(.Cells(2, 1), .Cells(LastRow, 2).End(xlToRight)).Copy
End With
With Sheets("PR0OnStd")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
If you wanted to write write code you can easily understand you wouldn't write code like this:-
Sheets("Base434").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
This is what your code says, translated into plain language:-
Look at sheet "Base434"
Look at cell A1 (implied: in that sheet)
Look at what you are looking at and extend your view to the last ??? right
(This is where the mistake is)
Copy what you are looking at.
Now, surely, if you wanted to understand what all this looking is aiming to do you might express the idea somewhat like this:-
Copy the cells in Row 1 of Sheet "Base434" from A1 to the end of the row.
With this kind of approach you would end up with code like this:-
Dim RangeToCopy As Range
Dim Cl As Long ' the last used column
With Worksheets("Base434")
Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set RangeToCopy = .Range(.Cells(1, 1), .Cells(1, Cl))
End With
MsgBox "Range to copy = " & RangeToCopy.Address
RangeToCopy.Copy
Would you say that this code is harder to read and understand than your version? Well, it has three advantages, even if it is. One, it doesn't have the fault that yours has. Two, it never got near to wanting to make the mistake that your approach made. Three, whatever errors it might still contain are easy to find and quick to eliminate.
Besides, it runs faster.
I've googled this but couldn't find a clear answer.
I have a workbook that contains lots of sheets, each sheet contains purchase order info.
I want to copy the same cell range from each sheet and compile a long list of all of those ranges.
my codes is currently;
Sub WorksheetLoop()
Sheets("5040001253").Select
Range("A4:O23").Select
Selection.Copy
Sheets("PO_Combi").Select
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A" & lastRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
My question is: is there a simple command that allows to replace the sheet named 5040001253 with that will make this macro repeat on all sheets? If not, could someone tell me what to do to make it so?
Next code copies Range("A4:O23") from each sheet (except PO_Combi) to column A of sheet PO_Combi:
Sub WorksheetLoop()
Dim sh As Worksheet
Dim shCombi As Worksheet
Dim lastrow As Long
Set shCombi = ThisWorkbook.Worksheets("PO_Combi")
For Each sh In ThisWorkbook.Worksheets
With shCombi
If sh.Name <> .Name Then
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
sh.Range("A4:O23").Copy
.Range("A" & lastrow + 1).PasteSpecial xlPasteValues
End If
End With
Next
Application.CutCopyMode = False
End Sub
I'm really new to programming in VBA and having a problem with this code I'm trying to write. I am wanting the code to figure out the first row in column A that is unused then copy and paste data from a different part of the sheet into that row.
Sub CopyandPaste()
Dim RowLast As Long
RowLast = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Set NewRange = ThisWorkbook.Worksheets("Sheet2").Cells(RowLast, 1)
ThisWorkbook.Worksheets("Sheet1").Cells(8, "B").Select
Selection.Copy
Range("NewRange").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Any help would be extremely helpful.
Try this code :
Sub CopyandPaste()
Dim RowLast As Long
ThisWorkbook.Activate
With Worksheets("Sheet2")
RowLast = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Sheets("Sheet1").Cells(8, "B").Copy Sheets("Sheet2").Cells(RowLast, 1)
End With
End Sub
I have added comments into the code explaining changes I made.
Sub CopyandPaste()
Dim RowLast As Long
Dim newRange As Range
'this works easier if I understand your intent right
'I generally use some large row number with Excel 2010
'You may ahve to make this smaller if you are in 03
RowLast = Sheets("Sheet2").Range("B99999").End(xlUp) + 1
'if you KNOW you have continuous data in this column (no spaces)
RowLast = Sheets("Sheet2").Range("B1").End(xldown) + 1
'this is slightly better way to do this
Set newRange = ThisWorkbook.Worksheets("Sheet2").Range("A" & RowLast)
'don't do this
'ThisWorkbook.Worksheets("Sheet1").Cells(8, "B").Select
'Selection.Copy
'do this instead
Sheets("Sheet1").Range("B8").Copy
newRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'you were attempting to use a variable name (newrange) as a
'name of a named range in the Excel sheet
'use the variable range itself (as above)
End Sub