I'm really hoping someone can help me with this one. I have recorded a macro to use within a sheet that needs to create a row at the same position on 2 worksheets and then, on one of them, copy the formula's in the cells from the row below it. The code I have looks like this -
Sub Macro1()
Sheets(Array("SCHEDULE", "ANNUAL SUMMARY")).Select
Sheets("SCHEDULE").Activate
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ANNUAL SUMMARY").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFill Destination:=ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow _
, Type:=xlFillDefault
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Sheets("SCHEDULE").Select
ActiveCell.Select
My problem is, when I run it manually and then record the macro, it does exactly what I want it to, but when I run this from a button on the "SCHEDULE" sheet it does not copy the formula's from the row below the one on the "ANNUAL SUMMARY" sheet.
Can anyone help to get this working with me?
Thanks all in advance
Mark
The problem with the macro recorder is that although it can give you a good indication of what code you need, it also generates very inefficient code and includes all of the select and activate statements that you need to try and avoid using.
Any reference in the code to ActiveCell is referring to the cell that is currently selected and ActiveSheet is the sheet that is currently selected. This can give you undesired results if you run the macro from a different sheet that the macro was recorded from...
If you wanted to copy row 1 from SCHEDULE sheet then you can use
Sheets("SCHEDULE").Rows(1).Copy Sheets("ANNUAL SUMMARY").Rows(1)
If you want to auto fill a range, then this can be accomplished with a single line of code
This will auto fill the contents of row1 (column A - E) down to row 100 in your ANNUAL SUMMARY sheet
Sheets("ANNUAL SUMMARY").Range("A1:E100").FillDown
So if we put it all together and include some declarations for our source and destination sheet to make the sub more readable..
Sub CopyAndFillDownExample()
Dim rowNumber As Long, offset As Long
Dim sourceSht As Worksheet, destinationSht As Worksheet
'set the source and destinationsheets
Set sourceSht = Sheets("SCHEDULE")
Set destinationSht = Sheets("ANNUAL SUMMARY")
'number of rows to copy down
offset = 100
'get currently selected row
rowNumber = ActiveCell.Row
'copy the selected row from the source sheet to the destination sheet
sourceSht.Rows(rowNumber).Copy destinationSht.Rows(rowNumber)
'fill down the formulas
destinationSht.Rows(rowNumber & ":" & rowNumber + offset).FillDown
End Sub
Related
I am pretty unfamiliar with VBA, and I am stuck with this portion of my code. I have a cell with a vlookup equation in it I'd like to use as a parameter to find a value in a table on a different sheet and copy the entire row over to a different sheet. I've used this code in the past to copy data over based on a single parameter, but I think the problem I'm running into is that the cell I'm trying to reference contains a vlookup equation in it.
Sub Test()
For Each cell In Sheets(RawDataLoader).Range("E:E")
If cell.Value = "B8" Then
matchRow = cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Dashboard").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("RawDataLoader").Select
End If
Next
End Sub
RawDataLoader is the sheet with my table
Dashboard is the sheet where I want the cells to go
B8 is the cell on the sheet Dashboard I want to use as the value the table looks up.
The range with the values I want it to search through is E:E and on the RawDataLoader sheet.
I know that the cell.value portion of my code is incorrect, I just do not know how to reference a cell value, so I put the cell I wanted to reference.
Thank you!
You just need to use Sheets("Dashboard").Range("B8").value instead of "B8". You can also simplify your code; avoid using Select and loop only on the used range instead of the full column.
Sub Test()
Dim cell as Range
For Each cell In Intersect(Sheets("RawDataLoader").UsedRange, Sheets("RawDataLoader").Range("E:E"))
If cell.Value = Sheets("Dashboard").Range("B8").value Then
cell.EntireRow.copy Sheets("Dashboard").Rows(cell.Row)
End If
Next
End Sub
I need to copy the cell contents in C10 from one sheet (called "New Customers") to another sheet's (called "Inventory") next available row.
Once the cell is copied, it should be copied or autofilled down 10 times. So 10 rows in the Inventory sheet have the same Customer ID populated.
Note: This macro will be ran multiple times and it should always populate the "Inventory" sheet with whatever the next avaiblaable 10 rows are at that point.
I have not figured out the Autofill part. That's where I need your help, the rest does what it should. Any ideas on how to fix this?
Sub copyCustomer()
'copy customer ID into inventory sheet. Then autofill inventory 10 times.
'need for this to OFFSET to add a new customer next time macro is ran.
Set Source = Sheets("New Customers")
Sheets("New Customers").Select
Range("C10").Select
Selection.Copy
Sheets("Inventory").Select
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
'Autofill this 10 times
End Sub
Try this (which replaces all your present code)
Sub copyCustomer()
Sheets("New Customers").Range("C10").Copy Sheets("Inventory").Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(10)
End Sub
I am trying to get the correct VBA code that will allow me to insert a row in to a filtered table at the same place on multiple worksheets and copy all of the content from the entire row above.
There is a check box relating to each sheet in the workbook. If the check box is ticked then the row should be inserted in to this sheet.
The sheets are password protected. The password is found in another of the worksheets in the file.
I have almost got this to work. My file can be found at the following location:
https://drive.google.com/file/d/0B5HnHgSNFkFid0gwbDNMOFN1NUU/view?usp=sharing
The code is as follows:
Sub Insert_Rows()
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name = "Sheet1" And Worksheets("Sheet4").Range("D1").Value = True Or _
sh.Name = "Sheet2" And Worksheets("Sheet4").Range("D2").Value = True Or _
sh.Name = "Sheet3" And Worksheets("Sheet4").Range("D3").Value = True Then
With sh
.Unprotect Password:=Worksheets("Sheet4").Range("A1")
.Cells(ActiveCell.Row, 4).EntireRow.Insert
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
.Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=Worksheets("Sheet4").Range("A1")
End With
End If
Next sh
End Sub
The issue I am having is that not all of the data from the row above is being copied. The data in the 5th column is not copying down. I am sure it is something to do with the 4 in the code .Cells(ActiveCell.Row, 4). I want it to copy the entire row above regardless of the number of columns.
Any help greatly appreciated.
Thanks
To FillDown the EntireRow, instead of just the Range between column 1 and column 4, replace
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
with
.Cells(ActiveCell.Row, 1).EntireRow.FillDown
(which could also be written as .Rows(ActiveCell.Row).FillDown)
Note:
Please remember that ActiveCell.Row is not necessarily referring to any special location on Sheet1, Sheet2, or Sheet3.
If the currently active cell is cell G67 on sheet Sheet4, then ActiveCell.Row will evaluate to 67 and so row 66 of Sheet1 (and/or Sheet2 and/or Sheet3) will be copied to a newly inserted row on Sheet1 (and/or Sheet2 and/or Sheet3) - it won't magically decide to insert row 58 on Sheet1 and row 82 on Sheet2, etc.
If the only problem you are having is that the entire row is not being filled down, then the solution above will fix it. But if you find that the wrong row is being filled down, then you will need to rethink how you are selecting the row.
I'm stuck on how to structure a piece of code that:
Loops through all worksheets that begin with the number 673: (e.g. 673:green, 673:blue)
Selects the data in these worksheets from row 5 up until the last row with data - code that works for this (generously provided by another user) is
Dim report As Worksheet
Set report = Excel.ActiveSheet
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End(xlUp)).EntireRow.Select
End With
Select the "Colours" worksheet
Paste the rows at the next available blank row. There could be up to 40/50 worksheets which will have data pasted into the "Colours" worksheet so I need the data added to the next available line.
Thank you in advance.
Loop over the sheets in the workbook and check their names
For Each sheet in ActiveWorkbook.Worksheets
If Instr(sheet.Name,"673")>0 Then
...
End If
Next
Good, but you're going to want to copy.
Selection.Copy
Just select.
Worksheets("Colours").Select
Find the last row then go to the next. The row is found by finding the first populated row from the bottom up. Note I used explicit sheet references, which is unnecessary since you selected the sheet already. This is better form, however, if you will be manipulating data on multiple sheets in your code.
lastRow = Worksheets("Colours").Cells(Worksheets("Colours").rows.count,1).End(xlUp).Row
Worksheets("Colours").Cells(lastRow + 1, 1).Select
Activesheet.Paste
I'm trying to make a code that checks for numbers in a master sheet called All in column D (ex. 780101) and if it meets the criteria, it copies the whole row and inserts (not paste) it to another sheet with the name of the criteria (ex. 780101), starting on row 6.
The code I have doesn't work like I want it to. It doesn't copy all the rows that meet the criteria and sometimes it inserts blank rows.
Sub Insert()
For Each Cell In Sheets("All").Range("D:D")
If Cell.Value = "780101" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow + 1).Select
Selection.Copy
Sheets("780101").Select
Rows("6:6").Select
Selection.Insert Shift:=xlDown
End If
Next
End Sub
I'm just starting to learn VBA, so if it could be possible the names of the sheets would be the criteria of the cell values (the code is made for only one sheet - 780101, but there are 20 of sheets with different names).
It's tough to make recommendations without seeing sample data and what could potentially be causing the problems you are having but you can run this rehash of your existing code.
Sub Insert()
Dim dc As Range
With Sheets("All")
For Each dc In Intersect(.Range("D:D"), .UsedRange)
If dc.Value2 = 780101 Then
dc.Resize(2, 1).EntireRow.Copy
Sheets("780101").Rows(6).Insert Shift:=xlDown
End If
Next
End With
End Sub
The nature of running that from top to bottom means that the results will be reversed. You may wish to consider running the main loop from bottom to top to maintain the order.