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
Related
I'm trying to copy some rows from a sheet and then paste in other sheet that will contain the data. Later on I will erase the data form the original sheet to be fulfill again and repeat process.
My problem is that, it looks like I'm coping as well the empty cells from the original sheet so when paste for any reason excel consider this empty cell as the last one. More than sure I'm doing something wrong, the macro is this:
Sub CopyTable()
'
' CopyTable Macro
'
'
' Variables
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = Worksheets("Form")
Set StartCell = Range("A9")
'Refresh UsedRange
Worksheets("Form").UsedRange
'Find Last Row and Column
LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column
'Select Range
sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
' Copy range and move to Data sheet
Selection.Copy
Sheets("Data").Select
' Place pointer on cell A1 and search for next empty cell
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
' Once find, go back once to place on last empty and paste data from Form sheet no formating
ActiveCell.Offset(0, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
End Sub
I assume that the data from the form always has an entry in column A - that there are no entries where A is blank but other cells on the row are not blank:
Sub CopyTable()
Dim sourcesheet As Worksheet
Dim DestSheet As Worksheet
Dim Source As Range
Dim dest As Range
Dim Startcell As Range
Set sourcesheet = ThisWorkbook.Worksheets("Form")
Set Startcell = sourcesheet.Range("A9")
Set Source = sourcesheet.Range(Startcell, Startcell.SpecialCells(xlCellTypeLastCell))
Set DestSheet = ThisWorkbook.Worksheets("Data")
Set dest = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
'set dest to next blank row
Source.Copy dest
Set dest = DestSheet.Range(dest, dest.SpecialCells(xlCellTypeLastCell))
dest.Sort key1:=dest.Cells(1, 1)
'sort to shift blanks to bottom
End Sub
finally surfing in stackoverflow I found a pice of code that do exactly want I need, so final macro looks like this:
Sub CopyTable()
Dim lastVal As Range, sht As Worksheet
Set sht = Sheets("Form")
Set lastVal = sht.Columns(2).Find("*", sht.Cells(1, 2), xlValues, _
xlPart, xlByColumns, xlPrevious)
Debug.Print lastVal.Address
sht.Range("A9", lastVal).Resize(, 26).Select 'select B:Ag
Selection.Copy
Sheets("Data").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
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 am trying to copy the last row and paste special at the next row. When I try the following code for an individual worksheet it works fine:
Sub Macro1()
Dim LR As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
Rows(LR).Select
Selection.Copy
Rows(LR + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
But when I am trying to loop through all worksheets, it is only pasting special in one of the worksheets the same copied row number of times instead of repeating to each worksheet. Could you please advise what I am doing wrong on the following for loop?
Sub Macro1()
Dim ws As Worksheet
Dim wb As Workbook
Dim LR As Long
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
If ws3.Name Like "*.plt" Then
LR = Range("E" & Rows.Count).End(xlUp).Row
Rows(LR).Select
Selection.Copy
Rows(LR + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next ws
End Sub
Thanks in advance!
To save some overhead, you should first refrain from using .Select and .Selection.*. If you anyways want to copy just the value you should do so via the .Value property of the cell. Secondly, you should use the With statement to make sure that you are referencing the target sheet. Finally, you should set unused objects to Nothing in the end. The following code should do the trick.
Code
Sub Macro1()
Dim ws As Worksheet
Dim wb As Workbook
Dim rng As Range
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
With ws
If .Name Like "*.plt" Then
Set rng = .Range("E" & Rows.Count).End(xlUp).EntireRow
rng.Offset(1).Value = rng.Value
End If
End With
Next ws
Set ws = Nothing
Set rng = Nothing
Set wb = Nothing
End Sub
I think that this
If ws3.Name Like "*.plt" Then
might be your issue. You need to enable Option Explicit so that you do not use undefined names.
Also, make
Set wb = ActiveWorkbook
to
Set wb = ThisWorkbook
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 new to VBA so am probably asking something really basic - sorry!
I have a worksheet with a series of records that I want to move into a different worksheet called "July Archive". I'm using this code and I know that this is going to overwrite the destination cells in "July Archive". But I get an error saying the pasteValue operation failed.
Also, how can I append the cells rather than overwrite. I tried PasteAppend but get an error say its not supported by the object.
Sub Selectweeklyreport()
ActiveSheet.Range("a16", ActiveSheet.Range("f16").End(xlDown)).Cut
ActiveSheet.Goto ("July Archive")
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
Like this?
Sub Selectweeklyreport()
Dim wsI As Worksheet, wsO As Worksheet
Dim lRow As Long
'~~> Replace this with the relevant sheet name
Set wsI = Sheets("Sheet1")
Set wsO = Sheets("July Archive")
With wsI
'~~> Get the last Row in Sheet1
lRow = .Range("F" & .Rows.Count).End(xlUp).Row
'~~> Copy the range from Sheet1
.Range("A16:F" & lRow).Copy 'and not .Cut????
'~~> Get the next available row in July Archive
lRow = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row + 1
'~~> Paste Special Values
wsO.Range("A" & lRow).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
End Sub