I have a sheet List. I want the contents of list to be transferred to my sheet Evaluation. But my evaluation sheet, already consist of the previous evaluation. I want the new rows just below the old ones. Can some one help how I can achieve this ?
I have the below code with me, which is a copy paste functionality.
Sub lastweekctt()
Worksheets("List").Range("A4:W1000").Copy _
Destination:=Worksheets("Evaluation").Range("A5")
End Sub
I have my header in row 4 in both the sheets.
You need to get last blank row:
Sub lastweekctt()
Dim LastRow As Long
'get last row
LastRow = Worksheets("Evaluation").Cells(Rows.Count,1).End(xlUp).Row
Worksheets("List").Range("A4:W1000").Copy _
Destination:=Worksheets("Evaluation").Range("A" & LastRow + 1)
End Sub
Hope this help.
You will need to find the last row first
lLastRow = Worksheets("Evaluation").Cells(Worksheets("Evaluation").Rows.Count, 1).End(xlUp).Row
and then your destination range will look like this
.Range("A" & lLastRow + 1)
Related
I'm struggling to find a way to copy two different continuous ranges (with columns right next to each other, for example: A;B;C and the second G;H;I); and paste it into the first empty row of another sheet, but this time I would like them merged in a continuum. (What once was “A;B;C”, “G;H;I” now I want it all in the first empty row of a new sheet but now “A;B;C;D;F;G” – note that D;F;G are G;H;I)
The code that I come up with was this one but it justs pastes the second range bellow the first one
Sub copy ()
lastrowa = Sheets("DATA").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
ActiveSheet.Range("A5:T1346").Copy Sheets("DATA").Rows(lastrowa) &
_ActiveSheet.Range("AC5:AH1346").Copy Sheets("DATA").Rows(lastrowa)
End Sub
I also tried to concatenate but it just freezes the process (never understood if it was even correct)
Notice that for range A5:T1346 I want it to be followed by AC5:AH1346; merged into a continuum (meaning that AC column should become U column) in the first empty row of sheet “DATA”
Any sugestions
Thks in advance
Try,
Sub copy ()
dim lastrowa as long
lastrowa = workSheets("DATA").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
with ActiveSheet
.Range("A5:T1346").Copy workSheets("DATA").cells(lastrowa, "A")
.Range("AC5:AH1346").Copy workSheets("DATA").cells(lastrowa, "U")
end with
End Sub
I'd like to use a Macro to name a table of data so that I can use that name to create a Pivot Table later in my Macro. The number of rows will change every time I use this Macro,so I need to find one that can identify the last row and grab all the data in Columns A,B,C and D from row 4 down to the last row of data. My code is presented below, I'm getting an error message on the last line. Any help would be much appreciated.
Sub Macro22()
Dim Lastrow As Long
Sheets("Statement").Select
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
ActiveWorkbook.Names.Add Name:="VendorData", RefersToR1C1:= _
"=Statement!A5:C" & Lastrow
ActiveWorkbook.Names("VendorData").Comment = ""
End Sub
Do you want to set the comment to "" or to remove the comment? Please include the error message you receive next time.
To remove:
If Not (ActiveWorkbook.Names("VendorData").Comment is Nothing) then ActiveWorkbook.Names("VendorData").Delete
To add/modify the text of a comment:
ActiveWorkbook.Names("VendorData").Comment.Text ""
I have two sheets of data. The first sheet is imported data that will show total users to my site from the day before. The second sheet is a table with all historical data from those daily reports. I'd like to automate a way to copy the data from my first sheet (that data will always be in the same cell) to a new row at the bottom of my existing table. Here's what I have:
Sub Insert_New_Rows()
Dim Lr As Integer
Lr = Range("AF" & Rows.Count).End(xlUp).Row
Rows(Lr + 1).Insert Shift:=xlDown
Cells(Lr + 1, "AF") = Cells(Lr, "AF") + 1
Sheets("Day Before").Range("$A$12:$B$12").Copy
Sheets("Historical").Cells(Lr + 1, "AF").Paste
Application.CutCopyMode = False
End Sub
In this, you'll see that my table is in columns AF and AG. When I run this macro, it only adds a row, it does not copy and paste the information.
I am not really sure where your table starts on the sheet "Day Before". So, I am assuming that it starts in row 1. Based on this assumption here is a little revision to your code:
Option Explicit
Sub Insert_New_Rows()
Dim lngNextEmptyRow As Long
Dim lngLastImportRow As Long
Dim shtYstrdy As Worksheet
Set shtYstrdy = ThisWorkbook.Worksheets("Day Before")
With ThisWorkbook.Worksheets("Historical")
lngNextEmptyRow = .Cells(.Rows.Count, "AF").End(xlUp).Row + 1
.Rows(lngNextEmptyRow).Insert Shift:=xlDown
.Cells(lngNextEmptyRow, "AF").Value2 = _
.Cells(lngNextEmptyRow - 1, "AF").Value2 + 1
lngLastImportRow = shtYstrdy.Cells(shtYstrdy.Rows.Count, "A").End(xlUp).Row
shtYstrdy.Range("A1:B" & lngLastImportRow).Copy _
Destination:=.Cells(lngNextEmptyRow, "AF")
End With
End Sub
Changes:
Explicit coding as suggested by #findwindow stating the workbook and the sheet before each Range, Cells, reference.
Copy and paste in one line of code (before three lines of code).
Using lngNextEmptyRow instead of LastRow so be can skip all these +1.
Determine the size (last row) of the table on the sheet "Day Before", so we know how much we need to copy over.
I hope this is the answer you've been looking for. Let me know if I misunderstood something or if anything requires more explanations.
There is no need to Active or Select Ranges. It is best to work with the Ranges directly. Rarely should you use ActiveCell, ActiveWorkSheet, or Selection.
This is how Copy and Paste work
Here is the shorthand for Copy and Paste
Range(SourceRange).Copy Range(DestinationRange)
Know that this will work for you:
Sheets("Day Before").Range("$A$12:$B$12").Copy Sheets("Historical").Cells(Rows.Count, "AF").End(xlUp).Offset(1)
I have a database that is growing quite large. Every day I add about 100 rows of information.
I have about 20 columns that autofill with calculations, etc. A few of those columns pull from a VERY large file using Vlookups. That takes forever because it's pulling the entire column everyday because my current autofill macro starts in row 2.
Is there any way to write the macro so that it autofills from the previous "last row" so it's only autofilling 100 or so new rows instead of several thousand?
I have tried the following with no luck:
Range("BZ2").AutoFill Destination:=Range("BZ2:BZ" & LastRow) is an example of one of my VBA codes for an autofill I use. LastRow is the last row after the new data is pasted in. I would like it to ideally start at the OldLastRow which would be the last row before I paste in the new data. I tried Range("BZ" & OldLastRow).AutoFill Destination:=Range("BZ" & OldLastRow & ":BZ" & LastRow) without luck.
Try this.
Dim LastRow As Long
With ActiveSheet
'This will get you the OldLastRow. Add +1 to the end to get the first empty row if you need it.
'The "A" in .Rows.Count, "A" should be replaced with a column that will always have data in every row.
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("BZ2").AutoFill Destination:=Range("BZ2:BZ" & LastRow)
'This will pause the macro until Calculations are complete.
Do While Application.CalculationState <> xlDone
DoEvents
Loop
End With
Ideally you would be doing the autofill from the point that you pasted your data in, so you wouldnt want to have "BZ2" anywhere in there if you just want to autofill new data.
you could try this one as well.
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "BZ").End(xlUp).Row
.Range("BZ2").AutoFill Destination:=Range("BZ" & LastRow & ":BZ" & Cells(Rows.Count, "BY").End(xlUp).Row)
Do While Application.CalculationState <> xlDone
DoEvents
Loop
End With
This is assuming you only have one column of calculations. if not change the "BZ" & LastRow & ":BZ" to "BZ" & LastRow & ":CA" or whatever your last calculated column is.
I recently posted a question, and unfortunately did not get very far with any answers. I have re-worked my macro to mirror a similar scenario I found elsewhere. The problem is I am now getting stuck at the very end.
Purpose of the macro:
1. Beneath the selected cell, I need to insert x new rows = entered months -1
In the first inserted row, I need a set of relative formulas that can be found in the Actual Row 2 of the current worksheet (basically copy and paste row 2 into the first row created)
In the subsequent inserted rows, I need a set of relative formulas that can be found in the Actual Row 3 of the current worksheet
As is, the macro does what I want, except I don't know how to paste row 3 in all subsequent rows. I'm assuming I need some conditional statement?
As mentioned in my last post, I am trying to teach myself VBA, so any help would be appreciated!!
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0)
Dim x As Long
ActiveCell.EntireRow.Select 'So you do not have to preselect entire row
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"Enter the total number of months in the program", Title:="Add Months", _
Default:=1, Type:=1) 'Default for 1 row, type 1 is number
If vRows = False Then Exit Sub
End If
Dim sht As Worksheet, shts() As String, i As Long
ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
Windows(1).SelectedSheets.Count)
i = 0
For Each sht In _
Application.ActiveWorkbook.Windows(1).SelectedSheets
Sheets(sht.Name).Select
i = i + 1
shts(i) = sht.Name
x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
Resize(rowsize:=vRows - 1).Insert Shift:=xlDown
Rows(2).EntireRow.Copy Destination:=Selection.Offset(1).Resize( _
rowsize:=1)
Rows(3).EntireRow.Copy Destination:=Selection.Offset(2).Resize( _
rowsize:=1)
On Error Resume Next
Next sht
Worksheets(shts).Select
End Sub
Ok, based on your comments, the below code should meet your needs. But first, a few things to note.
I've added several comments to help you understand what is happening in the code.
Based on your comment regarding vRows, the code will now terminate if the user keeps the default input box value ("1"). The logic is that if the value is only one, then no rows need to be added. Notice that I subtract 1 from the Inputbox value.
The code assumes you have headers or at least filled cells in row one. I use row one to find the last used column.
If there's any chance that the wrong sheet can be active when this code is executed, uncomment line 16 of my code. (Obviously you'd need to change the code to reflect your sheet's name.
Finally, this code assumes that the upper-left corner of your dataset is in A1.
Tested on Sample Dataset
Sub InsertMonthsAndFillFormulas(Optional vRows As Long = 0)
Dim lastCol As Long
Dim r As Range
'Ask user for number of months.
'If the user keeps the default value (1), exit sub.
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"Enter the total number of months in the program", Title:="Add Months", _
Default:=1, Type:=1) - 1
If vRows = 0 Then Exit Sub
End If
'Uncomment this line if you are concerned with which sheet needs to be active.
'ThisWorkbook.Sheets("YourSheet").Select
With ActiveSheet
'Set the range to work with as the cell below the active cell.
Set r = ActiveCell.Offset(1)
'Find the last used column. (Assumes row one contains headers)
'Commented this out to hard-code the last column.
'lastCol = .Rows("1:1").Find("*", searchdirection:=xlPrevious).Column
'Insert the new rows.
r.EntireRow.Resize(vRows).Insert Shift:=xlDown
'r needs to be reset since the new rows pushed it down.
'This time we set r to be the first blank row that will be filled with formulas.
Set r = .Range(.Cells(ActiveCell.Offset(1).Row, 1), _
.Cells(ActiveCell.Offset(1).Row, "H")) '<~~ Replaced lastCol with "H"
'**Add formulas to the new rows.**
'Adds row two formulas to the first blank row.
.Range(.Cells(2, 1), .Cells(2, "H")).Copy r
'Adds row three formulas to the rest of the blank rows.
.Range(.Cells(3, 1), .Cells(3, "H")).Copy r.Offset(1).Resize(vRows - 1)
End With
End Sub
Edit
The variable lastCol is what defines the right most column to copy formulas from. This variable is set using column headers in row 1. I prefer using variables like this to make the code more robust (i.e. you can add a column to your dataset without breaking the macro), however, for this to work you need headers above every used column (or at least cells that contain values).
If you aren't concerned with adding more columns in the furture, you can hard-code the last column into the code (see my revisions).