I'm trying to track weekly quantities I have in my spread sheet. So far I've made a macro to copy and paste the info where I need it. But it will only paste it to the spot I chose while recording the macro. I'd like it to paste the info into the next available column.
I'd also like to schedule the macro to run once a week on Friday morning.
Macro I'm using now.
Sub CopyPaste()
'
' CopyPaste Macro
'
'
Range("G4:G33").Select
Selection.Copy
Range("B35").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
I've tried putting & lastrow into the range, but it gets a compile error. Any help would be greatly appreciated.
At first sight maybe slightly more complex, but in a way a more pretty way of tackling the movement of values is to avoid using the clipboard with code like this:
Sub CopyPaste()
'
' CopyPaste Macro
'
'
Dim targetRng As Excel.Range
Dim destRng As Excel.Range
Set targetRng = Range("G4:G33")
Dim lc As Long
With Excel.ThisWorkbook.Sheets("Sheet1")
lc = .Cells(35, .Columns.Count).End(Excel.xlToLeft).Column
Set destRng = .Range(.Cells(35, lc), .Cells(35, lc)).Offset(0, 1).Resize(targetRng.Rows.Count, targetRng.Columns.Count)
destRng.Value = targetRng.Value
End With
End Sub
The above can be simplified to the following so you don't need to worry about using the last row variable:
Sub CopyPaste()
'
' CopyPaste Macro
'
'
Dim targetRng As Excel.Range
Dim destRng As Excel.Range
Set targetRng = Range("G4:G33")
With Excel.ThisWorkbook.Sheets("Sheet1")
Set destRng = .Cells(35, .Columns.Count).End(Excel.xlToLeft).Offset(0, 1).Resize(targetRng.Rows.Count, targetRng.Columns.Count)
destRng.Value = targetRng.Value
End With
End Sub
You can work out the column number of the last column like this:
Sub CopyPaste()
'
' CopyPaste Macro
'
Dim lastCol As Long
' this finds the number of the last column
lastCol = Cells(35, Columns.Count).End(xlToLeft).Column
Range("G4:G33").Copy
' Range("B35").Select
' no need to select. paste into the cell in row 35, one to the right of the last column
Cells(35, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
You could also add the 1 right in the lastCol definition, like
lastCol = Cells(35, Columns.Count).End(xlToLeft).Column + 1
Range("G4:G33").Copy
Cells(35, lastCol).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For scheduling the macro look at these two questions here and here
Related
So I'm trying to run a column through a table in Excel using VBA. I then want to copy the result and paste in another column. I've gotten it to work for one cell, however, when I try to loop the code, it just pastes the same thing in every cell in the range I want it to paste in. How do I make it so that when it loops, it only pastes in the single cell vs. the entire range? My code is below.
Sub Test1()
'
' Test1 Macro
'
'
Dim rng As Range, cell As Range
Set rng = Range("C16:C20")
For Each cell In rng
Dim rng2 As Range, cell2 As Range
Set rng2 = Range("G16:G20")
For Each cell2 In rng2
cell.Select
Selection.Copy
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D12").Select
Application.CutCopyMode = False
Selection.Copy
rng2.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Tranpose:=False
'ActiveCell.Offset(1, 0).Select
Next cell2
Next cell
End Sub
Thanks!
Guessing you want something like this:
Sub Test1()
Dim rng As Range, cell As Range, ws As Worksheet
Set ws = ActiveSheet
Set rng = ws.Range("C16:C20")
For Each cell In rng.Cells
ws.Range("B4").value = cell.Value
cell.offset(0, 4).value = ws.Range("D12").Value 'populate in Col G
Next cell
End Sub
Note there's typically no need to select/activate anything in excel (though the macro recorder does that a lot). Worth reviewing this: How to avoid using Select in Excel VBA
Likewise if you need to transfer values between cells you can do that directly without copy/paste.
I am trying to copy the same row of information from a sheet called "Report" (numbers will change), and paste the values into a sheet "Data" that has headers in the first row.
I tried piecing together some code from various questions.
Here is my code:
Sub Insert_Data()
'
' Insert_Data Macro
Sheets("Report").Range("B9:F9").Copy
Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub PSData_Transfer()
Sheets("Report").Range("B9:F9").Copy
Dim lastrow As Long
lastrow = Sheets("Data").Range("A65536").End(xlUp).Row
Sheets("Data").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
You may have to modify this a little bit to work with your code, but feel free to use mine that I'm using in my current worksheet and it works perfect!
Sub Insert_Data()
For R = LR To 2 Step -1 ' Change the 2 in "To 2" to the row just below your header,
' but typically row 2 is the second cell under header anyways
Call CopyTo(Worksheets(2).Range("B" & R & ":C" & R), Worksheets(1)Range("A:B"))
Next R
End Sub
Private Function CopyTo(rngSource As Range, rngDest As Range)
LR = rngDest.cells(Rows.Count, 1).End(xlUp).row
rngDest.cells(LR + 1, 1).value = rngSource.cells(1, 1).value
rngDest.cells(LR + 1, 2).value = rngSource.cells(1, 2).value
End Function
I don't like to use the copy method as it's slow and it likes to copy all the extra jargin, where as getting the value is much faster and it's retrieving ONLY the value
Good day,
May I ask if it is possible to run the macro even if some letters or characters on the title of the workbook I am working with is renamed?
this is the code I am working with:
Sub WBS()
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Total cost.xlsm").Worksheets(3).Range("A3:A300")
Set targetColumn = Workbooks("backing sheet (Jan).xlsm").Worksheets(2).Range("D6:D300")
sourceColumn.Copy
targetColumn.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Call Resource_Name
End Sub
what I really want to do is run the macro even if the name of the workbook is changed. as you can see the value I am copying is pasted on "backing sheet (Jan).xlsm" I want to change the name to "backing sheet (Feb).xlsm" and I know it wont run because the target workbook does not exist technically.
is there any possible way to deal with this?
Create a named range in your program with the date abbreviation - say called monthAbbr. Edit this every month. Then, change the VBA code to
Sub WBS()
Dim monthAbbr As String
monthAbbr = Range("monthAbbr").Value
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Total cost.xlsm").Worksheets(3).Range("A3:A300")
Set targetColumn = Workbooks("backing sheet " & monthAbbr & ".xlsm").Worksheets(2).Range("D6:D300")
sourceColumn.Copy
targetColumn.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Call Resource_Name
End Sub
I did it :). why did I make this code complicated.
incase others want to know the answer please see the code below.
Sub WBS()
Dim monthAbbr As String
monthAbbr = Range("monthAbbr").Value
Dim sourceColumn As Range, targetColumn As Range
Set sourceColumn = Workbooks("Total cost.xlsm").Worksheets(3).Range("A3:A300")
Set targetColumn = ThisWorkbook.Worksheets(2).Range("D6:D300")
sourceColumn.Copy
targetColumn.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Call Resource_Name
I forgot that there is a ThisWorkbook code. I can even change the whole name of my file :)
I'm using the below VBA code which is copying a range from Sheet1 and paste it in the same sheet. However i need to paste the data in the next available row of sheet2.
Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("A1:A5").Copy
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row
Sheets("Sheet2").Activate
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub
Please help me out..
Try this:
Private Sub CommandButton1_Click()
Dim lastrow As Long
Dim rng1 As Range
Dim rng2 As Range
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Set rng1 = Sheets("Sheet1").Range("A1:A5")
Set rng2 = Sheets("Sheet2").Range("A" & lastrow + 1)
rng1.Copy
rng2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub
Your code is good but one line you need to change it, that is place Sheets("Sheet2").Activate line before lastrow = Range("A65536").End(xlUp).Row
Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("A1:A5").Copy
Sheets("Sheet2").Activate
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row
Cells(lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub
First activate the sheet2 and then find last row
lastrow = Range("A65536").End(xlUp).Row
Could you please help me out with below formula? It gives object defined or app defined error. Thanks a lot.
Sub cellstovalues()
Sheets("Parsing").Select
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
As an alternative, you can simply assign the values to the Value2 (or Value) property of the range:
Sub cellstovalues()
With Sheets("Parsing")
With Intersect(.Range("B:B"), .UsedRange)
.Value2 = .Value2
End With
End With
End Sub
or for a specific range:
Sub cellstovalues()
With Sheets("Parsing").Range("B1:C10")
.Value2 = .Value2
End With
End Sub
Your code is having issues from you selecting the entire column B. Try using this. This should find the last used cell in your column, then copy and paste to convert the formulas to values like you want.
Sub cellstovalues()
Dim ws As Worksheet
Dim LastRow As Integer
Dim rng As Range
Set ws = ThisWorkbook.Sheets("Parsing")
With ws
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rng = .Range(.Cells(1, "B"), .Cells(LastRow, "B"))
End With
rng.Copy
rng.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub