VBA to copy multiple offset cells - vba

This is probably basic but I can't find how to do it.
I want to select a cell and an offset cell 3 cells to the right. Not any in between. So if I selected A2, it would copy A2 and A5.
I've managed to do one or the other but can't work out how to combine. I am a beginner.
Thanks for the replies so far. Realise I worded my question wrong. I want to copy whichever cell is selected in column A and the corresponding cell on the same line in column E I have this so far but I can't work out how to get the code to do both at the same time
' Keyboard Shortcut: Ctrl+Shift+C
'
ActiveCell.Copy
ActiveCell.Offset(0, 5).Copy
End Sub

Sub Try()
Dim Selected_, Paste_ As Range
On Error Resume Next
'Allow user to select cell
Set Selected_ = Application.InputBox("Please select cell you would like to copy", Type:=8).Select
'Copy user's selected cell
Selection.Copy
'Offset, to select column E with the same row as user's selection
Set Paste_ = ActiveCell.Offset(0, 4).Select
'Paste value
ActiveCell.PasteSpecial
End Sub
This should help :)

Related

Moving/deleting data in cells without moving/deleting formulas

I am busy creating a production schedule in excel 2010. I have used formulas to give me due dates for each job and a check box for when the job are done. I used the following VB to move the information to sheet 2 when the check box is checked.
Sub MoveData()
If ThisWorkbook.Worksheets(1).Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then
Range("A2:B2:C2:D2:E2:F2:G2:H2:I2:J2:K2:L2:M2").Select
Selection.Cut
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
End If
End Sub
The problem I have now is that it moves the formulas with the details in the cells from sheet 1 to sheet 2. I need the formulas to be locked in sheet 1 and affect new information inserted into the cells.
When the data in the row moves to sheet 2 the row is empty in sheet 1. Is there a way to automatically move all the remaining data up to fill the empty cells
Thanx
Do you just want to copy the values from Worksheets(1) to Sheets("Sheet2")?
Sub MoveData()
Dim r As Range
If ThisWorkbook.Worksheets(1).Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then
Set r = Worksheets(1).Range("A2:B2:C2:D2:E2:F2:G2:H2:I2:J2:K2:L2:M2")
Sheets("Sheet2").Range("A1").Resize(1, r.Count) = r.Value
'r.ClearContents
End If
End Sub
Instead of cut and paste try the following.
Sub MoveData()
If ThisWorkbook.Worksheets(1).Shapes("Check Box 1").OLEFormat.Object.Value = 1 Then
Sheets("Sheet2").Range("A1:M1").Formula = Sheets("Sheet1").Range("A2:M2").Formula
Range("A1").Select
End If
End Sub
Edit:
If you were cutting to remove the originals from Sheet1 just use,
Sheets("Sheet1").Range("A2:M2").Clear

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

Simple VBA selection: Selecting 5 cells to the right of the active cell

I am trying to select and a row of 5 cells to the right (the selection should include my active cell) of my active cell. My current code is:
Sub SelectandCopy()
'
' SelectandCopy Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
ActiveCell.CurrentRegion.Select
Selection.Copy
Windows("Study.xlsx").Activate
End Sub
I do want not a specific range from my worksheet because I want to be able to make a selection of these data sets from anywhere within my worksheet. Any help would be greatly appreciated!!
Would you use the Selection.Extend?
This copies the 5 cells to the right of the activecell. If you have a range selected, the active cell is the top left cell in the range.
Sub Copy5CellsToRight()
ActiveCell.Offset(, 1).Resize(1, 5).Copy
End Sub
If you want to include the activecell in the range that gets copied, you don't need the offset:
Sub ExtendAndCopy5CellsToRight()
ActiveCell.Resize(1, 6).Copy
End Sub
Note that you don't need to select before copying.
This example selects a new Range of Cells defined by the current cell to a cell 5 to the right.
Note that .Offset takes arguments of Offset(row, columns) and can be quite useful.
Sub testForStackOverflow()
Range(ActiveCell, ActiveCell.Offset(0, 5)).Copy
End Sub

Match cell value from two sheets and paste where the value is met, starting from one cell below

I'm new to VBA, I'm using Microsoft Office Excel 2007 and I read the forums but this seems impossible for me. I have the current code which copies a sheet and adds a day to the date and also copies a range of cells containing the important information from the sheet to be able to paste it in a calendar with realtime information and I need it to paste where the date is the same and one cell below the value which could be located in any place in a certain range.
Sub CopierPetete()
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveSheet
'update date
[J1].Value = [J1].Value + 1
'THIS IS MY POOR ATTEMPT TO MAKE IT WORK
If Sheets("Sheet5").Range("A1:K100").Value = ActiveSheet.Range("J1").Value Then _
ActiveSheet.Range("AA100:AC121").Select
Selection.Copy
Sheets("Sheet5").Select
Sheets("Sheet5").Pictures.Paste Link:=True
End If
End Sub
I need it to match the value in the ActiveAheet cell J1 with any cell on Sheet5, and paste as Pictures.Paste Link=True (or, if you have a better idea for a way to display real-time information) at the place where the value is met on Sheet5, one cell below.
Here's a link to the project!
If I understand well, what you intend to do is to check if the value of the ActiveSheet > cell J1 exists in the Sheet named "Sheet5" within the range A1 to K100. Meaninly, if Excel finds any cell withing A1 to K100 matching the J1 value, copy-paste the picture.
Here is a try:
Sub CopierPetete()
Dim rFind as Range
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveSheet
'update date
[J1].Value = [J1].Value + 1
'Find returns a range object, so we use Set
Set rFind = Worksheets("Sheet5").Range("A1:K100").Find(ActiveSheet.Range("J1").Value, LookIn:=xlValues, lookAt:=xlWhole)
If Not rFind is Nothing Then
ActiveSheet.Range("AA100:AC121").Copy
Worksheets("Sheet5").Activate
Worksheets("Sheet5").Range(rFind.Address).Offset(0, 1).Activate
Worksheets("Sheet5").Pictures.Paste Link:=True
End If
End Sub

Excel Macro: make a recorded one less cell specifc?

I've recorded a simple macro that I need to make into something generic, so it can be used for any row and last four cells. Here is my recroded version:
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
Range("Q12:T12").Select
Range("T12").Activate
Selection.Copy
End Sub
How do I
make it go to the last cell of the ROW I place the cursor into?
change the cell specific ranges into a range that just means: select this cell and 3 more to the left?
... the selection.copy I think I can nearly manage :)
Many thanks
Mike
This will copy the last four cells in any row you click into:
Sub CopyLastFourCellsOfRow()
Dim lastCell As Range
Dim rngToCopy As Range
Set lastCell = Selection.End(xlToRight)
Set rngToCopy = Range(lastCell, lastCell.Offset(0, -3))
rngToCopy.Copy
End Sub
Update - If your row has broken data then best approach is to start in the final column of the spreadsheet (column IV) and then work back. To achieve this replace the lastCell statement with the following:
Set lastCell = Cells(Selection.Row, 256).End(xlToLeft)
You can actually do the individual steps you're asking about all in one swift move.
To make it go to the last cell in the current row, you just use ActiveCell.End(xlToRight). (Use 'ActiveCell' because it is equivalent to 'Selection' when only one cell is selected, but works even if multiple cells are selected.)
Range(ActiveCell, ActiveCell.Offset(0, -3)).Select
will select the current cell and 3 more to the left. Note that you do not need to do "Selection.Copy" in a separate step. You can simply go:
Range(ActiveCell, ActiveCell.Offset(0, -3)).Copy