Looking for simple, elegant solutions using the range in its current form to append under another Worksheet's last row.
Range:
Sheets("conf_9").Columns(5).Copy Destination:=Sheets("Rec_9").Columns(9)
Sheets("conf_9").Columns(6).Copy Destination:=Sheets("Rec_9").Columns(10)
Sheets("conf_9").Columns(7).Copy Destination:=Sheets("Rec_9").Columns(7)
Sheets("conf_9").Columns(8).Copy Destination:=Sheets("Rec_9").Columns(8)
Sheets("conf_9").Columns(12).Copy Destination:=Sheets("Rec_9").Columns(6)
Several responses to a similar question seem overly complicated and incompatible to the Columns usage - yes, I am new to VBA. For example, inserting the expression Columns(number) & last row syntax is rejected.
Many thanks.
Try the next code, please. It is not necessary to copy whole columns. The code calculates the last filled row of the sheet to copy the column and the first empty row of the target sheet column:
Sub AppendToOtherSheet()
Dim shC As Worksheet, wsR As Worksheet, lastRowC As Long, lastRowR As Long
Set shC = Sheets("conf_9")
Set wsR = Sheets("Rec_9")
lastRowC = shC.Range("E" & Rows.Count).End(xlUp).row
lastRowR = wsR.Range("I" & Rows.Count).End(xlUp).row + 1
shC.Range("E2:E" & lastRowC).Copy Destination:=wsR.Cells(lastRowR, 9)
shC.Range("F2:F" & lastRowC).Copy Destination:=wsR.Cells(lastRowR, 10)
shC.Range("G2:G" & lastRowC).Copy Destination:=wsR.Cells(lastRowR, 7)
shC.Range("H2:H" & lastRowC).Copy Destination:=wsR.Cells(lastRowR, 8)
shC.Range("L2:L" & lastRowC).Copy Destination:=wsR.Cells(lastRowR, 6)
End Sub
The above code assumes that all columns have the same number of rows, and the sheet where from the columns are copied has column headers.
If the columns in discussion do not have the same number of rows, lastRowC and lastRowR must be calculated for each column to be copied. If no column headers, the range to be copied will start (for instance) from "E1" instead of "E2" in the first copying code line.
Related
I have a question. When
I ran the code below to autofill to a range (sheets will have different lengths of rows). In my example, the length I am filling down to is only 6 and only the first column (Column U) fills correctly. The rest go to the bottom of the sheet at 10000.
Sub MacroFill ()
Dim LastRow As Long LastRow = Range("T4").CurrentRegion.Rows.Count + 1
Range("U4:U" & LastRow).FillDown
Range("V4:U" & LastRow).FillDown
...
Range("AZ4:AZ" & LastRow).FillDown
End Sub()
The columns I am trying to autofill down are from U:AZ. Is there a more efficient way to get them autuofill based on how many number of rows have data in a specified column( in my case column T4:T)?
Thank you
I tried to create multiple LastRow variables and label them for each row but its not efficient. I tried to combine in the Range of the length of my rows.
I think it's because you referenced Col U twice.
Either that or your lastrow reference.
Try this:
Sub MacroFill()
Dim LastRow As Long
LastRow = Range("T" & Rows.Count).End(xlUp).Row
Range("U4:V" & LastRow).FillDown
'...
Range("AZ4:AZ" & LastRow).FillDown
End Sub
I am trying to paste a selection of rows to a new sheet.
It worked previously, but now run-time error 1004 tells me that I can't paste because the copy area and paste area aren't the same size.
When I attempt to run the code, I am sure to have the A1 cell of the new sheet selected.
When I debug, it takes me to the ActiveSheet.Paste line.
Sub exportconditionstarttoend()
Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
rownum = 1
colnum = 1
lastrow = Worksheets("ETM ETM0007").Range("W63000").End(xlUp).Row
With ActiveWorkbook.Worksheets("ETM ETM0007").Range("W1:W" & lastrow)
For rownum = 1 To lastrow
Do
If .Cells(rownum, 1).Value = "Condition 1 - Price 0.25" Then
startrow = rownum
End If
rownum = rownum + 1
If (rownum > lastrow) Then Exit For
Loop Until .Cells(rownum, 1).Value = "Condition 1 - Price 0.25 - End"
endrow = rownum
rownum = rownum + 1
Worksheets("ETM ETM0007").Range(startrow & ":" & endrow).Copy
Sheets("Result").Select
Range("W1").Select
ActiveSheet.Paste
Next
End With
End Sub
You are getting the error because you are copying every column and then trying to paste every column starting at cell W1. You are trying to paste 16,384 columns into a range that only has 16,362 columns. This leaves you with a 22 column deficit and thus the paste size error.
If you are copying every column, you always need to paste on Column A.
Similarly, if you are copying every row, you always need to paste on Row 1.
i.e. change Range("W1").Select to Range("A1").Select. Note you don't need to .Select a range to copy or paste it - see this post for reasoning and best practice.
Do you really need to copy every column?
The best solution is to limit the number of columns you need to copy either by hard coding the column range or dynamically defining the column range.
"I am sure to have the A1 cell of the new sheet selected" - from your code Range("W1").Select looks like your last selected cell is W1, so you can't paste a whole row there. The solution is to change W1 to A1 or select not the entire row but the range of the table, for example,
Worksheets ("ETM ETM0007"). Range ("A" & Startrow & ":" & "I" & Endrow) .copy or any other col/row range copy method.
I am trying to to create a macro to get the last row of data on my sheet & copy/paste it into the row before it.
I need it to pick up the data in Columns B-N.
I am able to do it for just column B using the below code but i cant figure out the syntax to get it do do it for column B-N - can someone help?
Sub copylastrow()
Worksheets("Sheet1").Activate
Range("B" & Rows.Count).End(xlUp).Copy
Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
End Sub
Some comments in the code:
Define the source sheet (no need to activate it)
Find the last row in an specific column
Set the source range according to columns and last row
Transfer values without copying them is faster
Assumptions:
Column B is the reference to get the last row
You're just pasting values
Read the comments and adjust the code to fit your needs.
Code
Public Sub CopyLastRow()
' Define the source sheet (no need to activate it)
Dim sourceSheet As Worksheet
Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
' Find the last row in an specific column
Dim lastRow As Long
lastRow = sourceSheet.Range("B" & sourceSheet.Rows.Count).End(xlUp).Row
' Set the source range according to columns and last row
Dim sourceRange As Range
Set sourceRange = sourceSheet.Range("B" & lastRow & ":N" & lastRow)
' Transfer values without copying them is faster
sourceRange.Offset(1).Value = sourceRange.Value
End Sub
Let me know if it works
I have a sheet where the cells in Column A auto-populate based on user input. Row 1 is the Headers. Row 2 is fully setup from B:JG with formulas as an example. I would like to have a button that runs a script to check Column A of each row, starting with 3, to see if its empty. If Column A is not empty, it should copy the FORMULAS from B2:JG2 and paste them into Columns B:JG on each row. If Column A is empty, I want it to leave the other columns blank.
I'm just diving into VBA, so any help with a script to accomplish is appreciated.
Example: Rows 3-110 have data in Column A, so B2:JG2 FORMULAS get copied into their B:JG columns. All rows after 110 get nothing because Column A is empty.
The button is on a sheet called "HexBox" and the sheet I need to update is "HexClean".
The user enters some info on the "HexBox" sheet and A:A is auto-populated based on their answers. So there could be 10 or 1000 rows in A:A with values and the rest up to 5000 will be "" if not applicable.
This approach simply
Copies the formulas from 2nd row down to the last used row as determined by Column A (one operation). Note that this step is indifferent of blanks in your column. That is handled in the following 2 steps
Loops through Column A and gather up instances of blank rows by adding them to a Union (collection of cells) (0 operations)
Clears the contents of the Union that is built in step 2 (one operation)
This is a more effecient way to go. Copying & pasting the formulas inside your loop one row at a time will lead to a lot of spread sheet operations. This method has a max of 2 operations
Sub HexSub()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("HexClean")
Dim LR As Long, i As Long, ClearMe As Range
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("B2:JG2").Copy
ws.Range(ws.Cells(3, "B"), ws.Cells(LR, "JG")).PasteSpecial xlPasteFormulas
For i = 3 To LR
If ws.Range("A" & i) = "" Then
If Not ClearMe Is Nothing Then
Set ClearMe = Union(ClearMe, ws.Range("A" & i))
Else
Set ClearMe = ws.Range("A" & i)
End If
End If
Next i
If Not ClearMe Is Nothing Then ClearMe.EntireRow.ClearContents
End Sub
If your range will never have blanks followed by more values, then you can just get rid of the loop and everything below it
If the non-blank cells in column A are typed values then SpecialCells should be able to find them quickly.
Sub populateBelow()
Dim frng As Range
With Worksheets("sheet3")
Set frng = .Range(.Cells(2, "B"), .Cells(2, "JG"))
With .Range(.Cells(3, "A"), .Cells(.Rows.Count, "A").End(xlUp))
With .SpecialCells(xlCellTypeConstants, xlTextValues + xlNumbers)
frng.Copy Destination:=.Offset(0, 1)
End With
End With
End With
End Sub
Sub CopyToMany()
Dim xRow As Range, aCel As Range
For Each xRow In ActiveSheet.UsedRange.Rows
If xRow.Row > 2 Then
Set aCel = xRow.Cells(1, 1)
If aCel.Value <> "" Then
ActiveSheet.Range("B2:JG2").Copy Destination:=ActiveSheet.Range("B" & xRow.Row & ":JG" & xRow.Row)
End If
End If
Next xRow
End Sub
I have looked through the forum, as well as Google, and I wasn't able to find an answer to what I'm trying to do.
One of the users [here][1] helped me get a code to copy data in a specific row (upon clicking a button) to the last row of a table that is found further down in the same sheet.
However, I'd like the sheet to scroll down to the last non-empty row of the table instead of scrolling manually. I understand that this can be accomplished through a combination of CTRL+SHIFT+"DOWN ARROW". However; the excel users are not very good with computers, so I am trying to make it as simple as possible to them.
Is there a VBA code that can do the job?
Thanks
So far, I am using Erin's code, which takes me to the last row of the spread sheet, instead of the last Non-Blank row. This could be because column A has formulas in all its cells, all the way down to the last cell. However, column A cells formulas are set to give blank unless there's data entered in their adjacent cells in column E.
Here's the code that I am using, which is pasted in the module.
Option Explicit
Sub copyRow()
Dim ws As Worksheet
Dim lRow As Long
' define which worksheet to work on, i.e. replace Sheet1 with the name of
your sheet
Set ws = ActiveWorkbook.Sheets("1. Clients Details")
' determine the last row with content in column E and add one
lRow = ws.Cells(Rows.count, "E").End(xlUp).Row + 1
' copy some cells into their ranges
ws.Range("E3:G3").Copy ws.Range("E" & lRow)
ws.[E1].Select
' combine H3, I3, J3, K3 and L3 and copy into column E, next empty row
ws.Range("H" & lRow) = ws.[H3] & " " & ws.[I3] & " " & ws.[J3] & ", " & ws.
[K3] & " " & ws.[L3]
' copy the other cells into their ranges
ws.Range("M3:Q3").Copy ws.Range("M" & lRow)
ws.[M1].Select
' combine H3 & I3
ws.Range("AA" & lRow) = ws.[H3] & " " & ws.[I3]
' combine J3, K3 & L3
ws.Range("AB" & lRow) = ws.[J3] & " " & ws.[K3] & " " & ws.[L3]
' copy Q3 into column Q only, if F3 = "Company"
If Worksheets("1. Clients Details").Range("F3").Value = "Company" Then
ws.Range("Q3").Copy ws.Range("Q" & lRow)
End If
Call scrollToEnd
End Sub
Sub scrollToEnd()
Dim lastrow As Long
Dim numRows As Long
numRows = Range("E1:E1000").Rows.count
lastrow = Range("E1:E1000").Columns(5).Rows(numRows).Row
ActiveSheet.Range("E" & lastrow).Activate
End Sub
Dim lastrow as long
Dim numRows as long
numRows = Range ("TableName").Rows.Count
lastRow = Range ("TableName").Columns (1).Rows(numRows).Row
Activesheet.Range("A" & lastRow).Activate
I can't test it right now, but I believe this will work. If you know the offset for your table, you can just do numRows + offset (mine are usually in A1, so I just add 1 for the header - numRows is data rows) to get your row number for the .Activate. :-)
Or to reach the same row as CTRL+SHIFT+"DOWN ARROW", regardless of the table:
With Activesheet
.Range("A" & .UsedRange.Rows(.UsedRange.Rows.Count).Row).Activate
End With
EDITED: I was thinking CTRL+END in the above code. To simulate CTRL+"DOWN ARROW" (adding SHIFT selects everything in its path...), you would actually use:
Range("A1").End(xlDown).Activate
You could simply paste this at the end of your sub since it is one line, or keep it as its own little sub if you are wanting to call it from a button-click. If it is column E that you want selected, you would simply replace "A1" with "E1".
This does assume that there are no blank cells in column E between "E1" and the last non-blank row. Otherwise, you will need to use the same logic as in your copyRow sub to find the last non-blank row:
ActiveSheet.Cells(Rows.Count, "E").End(xlUp).Activate
This will scroll down till the last row's cell is at the top left of the screen.
Sub test()
Application.Goto Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp), True 'where 'A' is the column of the last row
End Sub
You can paste the code at the bottom of your current procedure or assign it to a button.
EDIT:
Alternatively, you can try this. This will find the last row of any column.
Sub test()
Dim lastrow As Range
Set lastrow = Sheets("Sheet1").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not lastrow Is Nothing Then Application.Goto lastrow, True
End Sub