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)
Related
Sub Link()
Dim Turbidity As Long
Dim RawTurbidity As Range
'Sets variables Turbidity being the ActiveCell and RawTurbidity referring to the last captured cell in raw sheets'
Turbidity = ActiveCell.Row
Set RawTurbidity = Sheets("Raw Data").Range("C4").End(xlDown)
'The formula assigning the last captured cell in Raw sheets to the active cell '
Sheet1.Range(Sheet1.Cells(Turbidity, 4), Sheet1.Cells(Turbidity, 4)).Formula = RawTurbidity
End Sub
So this is the code I have and currently it does what it's suppose to do. We have two sheets atm sheet1 and Raw Data An instrument spits out data into column C of Raw data starting wtih C4 and going all the way down. The current code I wrote in essence paste the newest value the instrument spits out to the active cell in sheet1. I have a code on Raw Data that runs the macro only when a change is made to column C4 and lower. And it works exactly how I want it to however...
my question or issue is that when I add activecell.offset(1,0).select in order to have the activecell automatically go to the next row in sheet1 without me moving the mouse the macro copies and paste the same data into the next 4 cells. If I have the intrument spit out the data again than this time it occupies the next 6 rows with the same data.
Joe B, I think you are making this harder than it is.
Last value in a sheet column gets copied to the next open row in a specified column on another sheet? Is that right?
Option Explicit
Sub Link()
Dim ws1 As Worksheet
Dim wsRaw As Worksheet
Dim ws1LastRow As Long ' "Turbidity"
Dim wsRawLastRow As Long ' "RawTurbidity"
' I suggest you just name the sheets using the developer prop window
'It cuts this whole part out as you can call them directly
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set wsRaw = ThisWorkbook.Worksheets("Raw Data")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'lets say you are pasting to column A
'ws1LastRow = ws1LastRow + 1
'There you go the next writable cell row, this is wasted code though, see below you just increment when you need it
wsRawLastRow = wsRaw.Cells(wsRaw.Rows.Count, "C").End(xlUp).Row 'This method doesn't care if your data starts in C4
'No formula needed, it is a straight "copy" here, actually faster as its an assignment
ws1.Cells(ws1LastRow + 1, "A").Value = wsRaw.Cells(wsRawLastRow, "C").Value
'the next open cell (defined by row) in your sheet 1 column is equal to the last row of your Raw Data sheet column
End Sub
Issue is that the data in sheet one is not inputted in order. A person may need the data calculated to row 10 and the next calculation needs to be in row 20 hence the need to copy the data into the active cell.
This was my bad for not stating that in the initial post as it's the primary reason for this strange formula.
I am working with a file that has 10 columns with varied data in each one. There is only one column that has (fairly) consistent data. I will attach the file so that hopefully it will help with what I am trying to do.
I want to have the unique values copy over to another worksheet. There are multiple ACD options, but I only want ACD to be copied IF the cell above it contains the value RING. Additionally, I would like to copy over the first TIME column, if possible the second. If necessary I will have a macro change the names to the second column to length.
Data File
I know that advanced filters can be utilized but I have not yet been able to figure out how to properly set it up.
Any tips would be greatly appreciated!
Is this what you needed? I'm pretty new to VBA though but it works.
Sub CopyData()
Dim lastrow As Long, LocY As Long, lastcopy As Long
Dim source As Worksheet, dest As Worksheet
Set source = Worksheets("Sheet1")
Set dest = Worksheets("Sheet2")
lastrow = source.Cells(Rows.Count, 1).End(xlUp).Row 'Checks for the last row that contains data in the source
lastcopy = dest.Cells(Rows.Count, 1).End(xlUp).Row + 1 'Checks for the last row with data in the destination and move down by one to prime for data entry
For LocY = 2 To lastrow 'LocY referring to current location
If source.Cells(LocY, 7).Value = "RING" Then 'Check if current locations at column 7 in source sheet contains the value RING
source.Cells(LocY, 2).Copy
dest.Cells(lastcopy, 1).PasteSpecial xlPasteValues 'pastes the value into the last row of destination sheet.
source.Cells(LocY, 7).Copy
dest.Cells(lastcopy, 2).PasteSpecial xlPasteValues
source.Cells(LocY, 10).Copy
dest.Cells(lastcopy, 3).PasteSpecial xlPasteValues
lastcopy = lastcopy + 1 'moves the target row in the destination down by one to prime for data entry.
End If
Next
End Sub
I have a "Task Tracker" workbook that uses columns A:J to display and calculate task information (A:E are for user-entered data, F:J contain formulas that use the information in C:E and perform calculations. F:J are hidden cells in the user view.) The remainder of the columns display a heat map of where the tasks fall on a timeline, and whether or not they are running on time, are behind, or are complete.
There are two buttons for users to use: one to insert a new row, and one to insert a new column. The InsertRow() macro inserts a row into the list, then copies the formulas down from the above row. The InsertColumn() macro locates the last used column in the worksheet and copies everything over from the column to the left of it.
Originally, I had a macro for InsertRow using Range that copied from Column F (where the formulas start) to Column XFD. However, once I created the InsertColumn macro I realized that I cannot do InsertRow like that because InsertColumn needs to locate the last data-containing column in the worksheet and add a new one to the right...and if InsertRow gets run first, InsertColumn won't work because the value for lastColumn comes back as the index of column XFD.
What I am looking for help with:
I need to locate the lastColumn value in my InsertRow macro, then use that value as part of the Range when the program executes the Copy/Paste portion of the code. I think that the problem I'm having has to do with the fact that the code I'm using to find the last column returns the index, and the Range function needs the name of the column.
Here is what I have for both macros:
Sub InsertTaskRow()
' InsertTaskRow Macro
'
' This macro inserts a new row below whatever role the user currently has selected, then
' copies the formulas and formatting from above down to the new row
Dim lastColumn As Long
Dim currrentRow As Long
Dim newRow As Long
lastColumn = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Column
currentRow = ActiveCell.Row
newRow = currentRow + 1
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown
Range("F" & currentRow & ":" & lastColumn & currentRow).Copy Destination:=Range("F" & newRow & ":" & currentRow & newRow)
End Sub
Sub InsertColumn()
' InsertColumn Macro
'
' This macro copies the formulas and formatting from the last data-containing column
' in the worksheet, and pastes it into the next column to the right.
Dim lastColumn As Long
lastColumn = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Column
MsgBox lastColumn
Columns(lastColumn).Copy Destination:=Columns(lastColumn + 1)
End Sub
You can try changing your lastColumn occurances to the following:
lastColumn = ActiveSheet.Range("A1").End(xlToRight).Column
This will stretch your range to all used cells. I tried using the clCellTypeLastCell, but it was pulling further than necessary for no apparent reason; even after deleting the entire columns it claimed were applicable. Just an FYI, there is no issue with using indexes or column names when utilizing Range() - even interchangibly, they are both fully qualified.
I am trying to create an "Insert Column" macro in Excel.
The workbook uses formulas and conditional formatting to display progress along a timeline. I need to provide users with a way to add additional columns to the timeline.
The macro I am trying to build locates the last column and copies the entirety of column lastColumn into column newColumn. However, everything that I find online and try to adapt either gives me an object error or doesn't do anything. Please help me figure out how to do this.
Here's my code so far.
Sub InsertColumn()
Dim lastColumn As Long
Dim newColumn As Long
With ActiveSheet
lastColumn = .Range("A1").SpecialCells(xlCellTypeLastCell).column
End With
newColumn = lastColumn + 1
Selection.AutoFill Destination:=Columns(lastColumn & ":" & newColumn), Type:=xlFillDefault
End Sub
If you are simply trying to copy the one column to another then this will work:
Sub InsertColumn()
Dim lastColumn As Long
lastColumn = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Column
Columns(lastColumn).Copy Destination:=Columns(lastColumn + 1)
End Sub
I have vba question I have been trying to find the answer for for a long time. I have numerous spreadsheets from numerous clients that I run macro's on, I'm new to coding and have been able to mostly figure out what I need to do. My clients send us data monthly and every month the number of rows change. The columns don't change but the amount of data does. My previous macro's I have just chosen the entire column to copy and paste onto our companies template. This worked fine for must things but has created some really long code and macros take a long time. I would like to write a code that counts how many rows are in a certain column and then from there copies and pastes that however many rows it counted in each column. Only a few columns contain data in every row, so I need it to count the rows in one specific column and apply to that every column. Any help would be appreciated.
Thanks
Tony
Hi Guys,
Still having issues with this, below I pasted the code I'm using if anyone can see why it won't run please help.
Windows("mmuworking2.xlsx").Activate
Workbooks.Open Filename:= _
"C:\Users\I53014\Desktop\QC DOCS\Sample_Data_Import_Template.xlsx"
Windows("mmuworking2.xlsx").Activate
Dim COL As Integer
COL = Range("A:DB").Columns.Select
**Range(Cells(2, COL), Cells(Range("E" & Rows.Count).End(xlUp).Row, COL)).Copy Destination:=Windows("Sample_Data_Import_Template.xlsx").Range("A2")**
Range("A2").Paste
Range("A5000").Formula = "='C:\Users\I53014\Desktop\[Import_Creator.xlsm]sheet1'!$B$2"
ActiveWorkbook.SaveAs Filename:="Range (A5000)", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
I bolded where it keeps stopping.
This should give you the last row containing data:
ActiveSheet.UsedRange.Rows.Count
This will give you the last row in a specific column:
Range("B" & Rows.Count).End(xlUp).Row
here is an example of how I can copy every row in the first three columns of a worksheet
Sub Example()
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
Range(Cells(1, 1), Cells(LastRow, 3)).Copy Destination:=Sheet2.Range("A1")
End Sub
You have to be careful as there are some caveats to both methods.
ActiveSheet.UsedRange may include cells that do not have any data if the cells were not cleaned up properly.
Range("A" & Rows.Count).End(xlUp).Row will only return the number of rows in the specified column.
Rows(Rows.Count).End(xlUp).Row will only return the number of rows in the first column.
Edit Added an example
Edit2 Changed the example to be a bit more clear
For this example lets say we have this data
You could copy any other column down to the number of rows in column A using this method:
Sub Example()
Dim Col as Integer
Col = Columns("C:C").Column
'This would copy all data from C1 to C5
'Cells(1, Col) = Cell C1, because C1 is row 1 column 3
Range(Cells(1, Col), Cells(Range("A" & Rows.Count).End(xlUp).Row, Col)).Copy Destination:=Sheet2.Range("A1")
End Sub
The end result would be this: