I have seen some examples but they have been using .Select and .Activate. I am trying to learn how to not use those anymore because everyone says you should try to stay away from them.
I want to take a row, then copy it to the first blank row on the other sheet. I was close but it just isn't working.
UsdRws = Range("A" & Rows.Count).End(xlUp).Row
With Sheets("Totals by Department")
.Range("A1:Z" & UsdRws).autofilter Field:=1, Criteria1:="1450"
.Range("A2:Z" & UsdRws).SpecialCells(xlCellTypeVisible).EntireRow.COPY
End With
Set NextRow = Range("A" & Sheets(2).UsedRange.Rows.Count + 1)
Sheets(2).NextRow.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
The first part copies perfectly, I really just need help pasting it over on the other sheet. I will also take other recommendations for cleaning the code up. Like I said I am trying to learn to write better. The second part is messy because I have been adding and editing it but now I am lost.
Your "NextRow" object is a Range object, but you are calling it as if it were a method or property of Sheets(2).
Try removing the Sheets(2). and just start with Next Row.
Set NextRow = Sheets(2).Range("A" & Sheets(2).UsedRange.Rows.Count + 1)
NextRow.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
' UsdRws is equal the last used row on whichever sheet is active at the moment that this code runs
UsdRws = Range("A" & Rows.Count).End(xlUp).Row
' this code properly references ranges on a specific worksheet, regardless of which worksheet is active
With Sheets("Totals by Department")
.Range("A1:Z" & UsdRws).autofilter Field:=1, Criteria1:="1450"
.Range("A2:Z" & UsdRws).SpecialCells(xlCellTypeVisible).EntireRow.COPY
End With
' NextRow is reference to a cell on whichever sheet is active at the moment that this code runs
' but the row referenced is same as the first emply cell on Sheets(2)
Set NextRow = Range("A" & Sheets(2).UsedRange.Rows.Count + 1)
' NextRow is already a range .... so it should be NextRow.PasteSpecial ......
Sheets(2).NextRow.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
this may be what you want
With Sheets("Totals by Department")
UsdRws = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:Z" & UsdRws).autofilter Field:=1, Criteria1:="1450"
.Range("A2:Z" & UsdRws).SpecialCells(xlCellTypeVisible).EntireRow.COPY
End With
Set NextRow = Sheets(2).Range("A" & Sheets(2).UsedRange.Rows.Count + 1)
NextRow.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
Related
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.
Please help me for this problem:
I use this vba from this link:
Sub test()
Dim rng1 As Range, rng2 As Range, rngName As Range, i As Integer, j As Integer
For i = 1 To Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
Set rng1 = Sheets("Sheet2").Range("B" & i)
For j = 1 To Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
Set rng2 = Sheets("Sheet1").Range("C" & j)
Set rngName = Sheets("Sheet1").Range("B" & j)
If rng1.Value = rng2.Value Then
rngName.Copy Destination:=Worksheets("Sheet2").Range("E" & i)
End If
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
End Sub
Can somebody show me how to combine rngName.Copy with
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
I would like to earn, that the rngName.Copy copy only text, because I have special color, text format, comment etc. in the cells, where the vba paste the changed values and I would like to stay these.
Do you mean this?
rngName.Copy
Worksheets("Sheet2").Range("E" & i).PasteSpecial Paste:=xlPasteFormulas, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
You may also want xlPasteValues instead of xlPasteFormulas. In this case, a simpler and better way is to take the value without using copy/paste:
Worksheets("Sheet2").Range("E" & i).Value = rngName.Value
All of the methods above conserve the formatting of the destination.
I'm having trouble copying specific Rows with vba.
Here my Code:
Dim color1 As Integer
Dim color2 As Integer
Dim lines As Integer
Workbooks.Open Filename:="D:\01 January.xlsm", _
UpdateLinks:=0
lines = WorksheetFunction.CountA(Range("U:U")) - 1
Dim i As Integer
For i = 6 To lines + 6
color1 = Cells(i, 21).Value
color2 = Cells(i, 22).Value
If IsNumeric(Cells(i, 21)) Then
Select Case color1 & color2
Case Evaluate("=White") & Evaluate("=Blue")
Rows(i & ":" & i).Select
Case Evaluate("=Yellow") & Evaluate("=Yellow")
Rows(i & ":" & i).Select
Case Evaluate("=Yellow") & Evaluate("=Green")
Rows(i & ":" & i).Select
End Select
End If
Next i
Selection.Copy
Windows("Test.xlsm").Activate
Rows("11:11").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
So as you might see, I am trying to select Rows, that meet the criteria in the January.xlsm and paste them afterwards into the test.xlsm
At the moment it only pastes the last selected row and not all of them.
I'm pretty new to vba, so I would really need your help here. What I got in my mind, is to put all the needed rows into an array and then copy it into the other workbook. But no idea if thats good or just rubish and if that would work, I can't find a solution...
Thanks for all your help!
The reason it only pastes the last row is because you're looping through selecting the individual rows but not doing anything with them. See amended code.
I've removed the redundant selections in the case statement and provided a range/union combo to create your custom range to ensure you're only pasting to the worksheet once.
Dim color1 As Integer
Dim color2 As Integer
Dim lines As Integer
Workbooks.Open Filename:="D:\01 January.xlsm", _
UpdateLinks:=0
lines = WorksheetFunction.CountA(Range("U:U")) - 1
Dim i As Integer
Dim rngUnion As Range
Dim booCopy As Boolean
For i = 6 To lines + 6
booCopy = True
color1 = Cells(i, 21).Value
color2 = Cells(i, 22).Value
If IsNumeric(Cells(i, 21)) Then
Select Case color1 & color2
Case Evaluate("=White") & Evaluate("=Blue")
Case Evaluate("=Yellow") & Evaluate("=Yellow")
Case Evaluate("=Yellow") & Evaluate("=Green")
Case Else
booCopy = False
End Select
End If
If booCopy = True Then
If rngUnion Is Nothing Then
Set rngUnion = Rows(i & ":" & i)
Else
Set rngUnion = Union(rngUnion, Rows(i & ":" & i))
End If
End If
Next i
If Not rngUnion Is Nothing Then
rngUnion.Copy
Windows("Test.xlsm").Activate
With Rows("11:11")
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False
End If
End Sub
The reason this only pastes the last selected row is because you are not copying and pasting within the loop. If you move the Selection.Copy/Paste within the loop the code should work. A better way to do this would be to avoid copying and pasting entirely and directly set the values of the rows. See code below:
Dim i As Integer
For i = 6 To lines + 6
color1 = Cells(i, 21).Value
color2 = Cells(i, 22).Value
If IsNumeric(Cells(i, 21)) Then
Select Case color1 & color2
Case Evaluate("=White") & Evaluate("=Blue"):
Workbooks("Test").Sheets("Sheet1").Rows(i).Value = _
Workbooks("01 January").Sheets("Sheet1").Rows(i).Value
...
End Select
End If
Next i
You can just update the sheet or workbook names as necessary but this method is substantially faster than copying and pasting.
should you have a large number of rows to be copied and paste it's safer not to rely neither on Union() nor Address() methods and switch to a "helper" column where to first mark the row for copying and then copy and paste in one shot. This is also much faster then the two methods above
you can also take advantage of SpecialCells() method to filter "numeric" cells only:
Dim lines As Long
Dim cell As Range
Workbooks.Open Filename:="D:\01 January.xlsm", UpdateLinks:=0
lines = WorksheetFunction.CountA(Range("U:U")) - 1
With Range(Cells(6, "U"), Cells(lines + 6, "U")) '<--| reference your relevant range in column "U"
For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through "numeric" cells only
Select Case cell.Value & cell.Offset(, 1).Value
Case Evaluate("=White") & Evaluate("=Blue"), Evaluate("=Yellow") & Evaluate("=Yellow"), Evaluate("=Yellow") & Evaluate("=Green")
cell.Offset(, 2).Value = 1 '<--| mark row for copying&pasting
End Select
Next
With .Offset(, 2) '<-- consider column "W" cells corresponding to referenced cells
If WorksheetFunction.CountA(.Cells) > 0 Then '<--| if there's at least one row marked for copy&paste
.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Copy '<--| copy all marked rows
With Workbooks("Test.xlsm").ActiveSheet.Rows("11:11") '<--| reference target range
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
Application.CutCopyMode = False '<--| clear clipboard
End If
.ClearContents '<--| clear "helper" column
End With
End With
Sub FIXPAY()
Dim LastCol As Long, LastRow As Long, s2 As Worksheet
Set s2 = Sheets("Analysis")
s2.Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Copy
s2.Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial xlPasteAll
'*Copy the table header from 1st table and paste it to the second empty row.*
Range("A3:C3").Select
Range(Selection, Selection.End(xlDown)).Copy
s2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'*Copy from A3:C3 to the last filled row and paste it to the row right below
the heading.*
s2.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).FormulaR1C1 = _
"=INDIRECT(""'""&RC1&""'!""&ADDRESS(ROW(R73C[-2]),COLUMN(R73C[-2])))"
'*Put the above formula in the D Column right below the heading*
The problem lies here.How can I replace the below line with dynamic range such that it will auto-fill the data in the D Column
s2.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).FormulaR1C1 = _
"=INDIRECT(""'""&RC1&""'!""&ADDRESS(ROW(R73C[-2]),COLUMN(R73C[-2])))"
s2.Range("D15").AutoFill destination:=Range("D15:D" & Range("A15").End(xlDown).Row)
LastCol = Cells(14, Columns.Count).End(xlToLeft).Column
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("D15", Cells(LastRow, LastCol)).FormulaR1C1 = Range("D15").FormulaR1C1
End Sub
Can someone please help me making the code fully dynamic? Please note that I have referenced as row 15 here because my heading of the second table is in row 14 and hence the formula from D15 is to be copied to the last filled row and last filled column.
I want to assign a macro that copy several values from one sheet to another, and so far I've come to this:
Sub botaoconfirmar_click()
Range("C6").Select
Selection.Copy
Worksheets("Historico").Select
lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
Range("B" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("C59").Select
Selection.Copy
Worksheets("Historico").Select
lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
Range("C" & lMaxRows + 1).Select
Selection.PasteSpecial , Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
The problem is that when I click the button with this macro it only performs the first action. If I change the order, it still performs only the first action (former #2).
What am I doing wrong?
Specifically to your problem, you're not qualifying the Sheet associated with the Copy statement. So, when you copy Range("C59"), your code is still on Sheets("Historico"). Change both of your initial selection statements to, for example, Sheets("Data").Range("C6").Select.
On a side note, the code is not running optimally. There is no need to select each cell and sheet that you intend to work with. The best way to write the code would be (again, assuming the data is in a sheet named "Data"):
Sub botaoconfirmar_click()
Dim wsData As Worksheet
Dim wsHistorico As Worksheet
Dim lMaxRows As Long
Set wsData = Worksheets("Data")
Set wsHistorico = Worksheets("Historico")
lMaxRows = wsHistorico.Cells(Rows.Count, "B").End(xlUp).Row
wsHistorico.Range("B" & lMaxRows + 1).Value = wsData.Range("C6")
lMaxRows = wsHistorico.Cells(Rows.Count, "C").End(xlUp).Row
wsHistorico.Range("C" & lMaxRows + 1).Value = wsData.Range("C59")
End Sub