Copy cell inot another sheet and Autofill the copied cell 10 times - vba

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

Related

Copy range from multiple sheets rather than just one sheet

Background
I have a workbook with 7 sheets but only 6 with data. All of these 7 sheets have the same structure/headings, it's just that the last sheet (sheet 7) is blank.
I want to write a code that will copy the contents of sheets 1-6 in the range of A2:J15 into the sheet 7 worksheet. I currently have a code that I have been using to test and see if it works but the code I have only copies and pastes from one worksheet only (see below). Any suggestions?
In the below, I have two sheets where I want the data to come from and the destination sheet where I want the data to go:
Sub sbCopyRangeToAnotherSheet()
Sheets("Source1").Range("A1:B10").Copy
Sheets("Source2").Range("A1:B10").Copy
Sheets("Destination").Activate
Range("A1:B10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Your problem is coming from your attempt to copy two items directly after each other. The second copy call is overwriting the data you copied in the first call.
Sheets("Source1").Range("A1:B10").Copy
Sheets("Destination").Activate
Range("A1:B10").Select
ActiveSheet.Paste
Sheets("Source2").Range("<your new range here>").Copy
Sheets("Destination").Activate
Range("<your new range here>").Select
ActiveSheet.Paste
Application.CutCopyMode = False
The code above should explain what I mean albeit not the most efficient way. A more effective way would be to use:
Sheets("Source1").Range("A1:B10").Copy Destination:=Sheets("Destination").Range("A1:B10")
Sheets("Source2").Range("A1:B10").Copy Destination:=Sheets("Destination").Range("<range>")
As sugguested in the comments:
Sub sbCopyRangeToAnotherSheet()
Sheets("Source1").Range("A1:B10").Copy Sheets("7").Range("A1")
Sheets("Source2").Range("A1:B10").Copy Sheets("7").Range("A1").end(xlDown).offset(1,0)
Sheets("Source3").Range("A1:B10").Copy Sheets("7").Range("A1").end(xlDown).offset(1,0)
Sheets("Source4").Range("A1:B10").Copy Sheets("7").Range("A1").end(xlDown).offset(1,0)
Sheets("Source5").Range("A1:B10").Copy Sheets("7").Range("A1").end(xlDown).offset(1,0)
Sheets("Source6").Range("A1:B10").Copy Sheets("7").Range("A1").end(xlDown).offset(1,0)
End Sub
Assuming that you want to paste the data by rows (and not overwrite it), and your sheets are named Source1 to Source6, then the following should work:
Sub testSO()
For i = 1 To 6
Sheets("Source" & i).Range("A1:B10").Copy Sheets("Destination").Range("A" & Rows.Count).End(xlUp).Offset(1)
Next i
End Sub

Excel VBA insert row and copy data on multiple sheets

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.

Excel: Copy and insert rows on another sheet based on cell

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.

How to copy only formulas from one excel sheet which can dynamically grow to another sheet using macro

I have two excel sheets sheet1 and sheet2.Sheet1 is a dynamic excel sheet,there may be chance of adding columns.I have already coded to copy column heading from sheet1 to sheet2 dynamically.
Sheet1:
Prdct Id PrdctQty Unitprice PrdctQty
1 5 10 50
2 10 10 100
sheet2:
Prdct Id PrdctNme Unitprice PrdctQty
When i open sheet2,these headings automatically appears from sheet1(using macro).There are 2 buttons in sheet2.
1.Display-display product details on matching Prdct Id entered by the user(that also done through macro)
2.Add- To add new product,user can enter Prdct Id , PrdctNme, Unitprice and it will be copied to sheet1 (through macro)
Sheet1 also contains other columns having fromulas(which i didnt show in the example)and sheet1 can grow dynamically.
So what i want is when user enters Prdct Id , PrdctNme, Unitprice then PrdctQty should automatically come in sheet2 (along with other calculated columns which i am not including for the time being) and after that i can add the new product to sheet1
i tried this code (from stackoverflow)
Sub dural()
Dim r As Range, ady As String
For Each r In Sheets("Sheet1").Cells.SpecialCells(xlCellTypeFormulas)
ady = r.Address
r.Copy Sheets("Sheet2").Range(ady)
Next
End Sub
but what i am getting is a whole copy of sheet1 in sheet2 along with values.What i need is only formulas not values
Try Something like this :
Sub moveformulas ()
Sheets(1).UsedRange.SpecialCells(xlCellTypeFormulas).Copy
Sheets(2).Range("A1").PasteSpecial
End Sub
I found a way even though i am not sure its the right way.
Sub dural()
Dim r As Range, ady,ady2 As String
For Each r In Sheets("Sheet1").Cells.SpecialCells(xlCellTypeFormulas)
ady = r.Address
ady2=r.formula
Sheets("Sheet2").Range(ady).formula=ady2
Next
it worked for me
Sub CopyOnlyFormulas()
Sheets(1).UsedRange.Copy
Sheets(2).Cells.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
For Each cell In Sheets(2).UsedRange
If Not cell.HasFormula Then
cell.Clear
End If
Next
End Sub
Sub CopyDataAndFormulas()
Sheets(1).UsedRange.Copy
Sheets(2).Cells.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
End Sub

VBA code in Excel to add a row to multiple sheets and then copy formula from adjacent row

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