VBA Macro for Pasting Data In New Row of Table - Excel - excel

I have recorded a macro that is attempting to copy information from cells outside of a table and paste them into a new row in a table on the same sheet. When trying to run the macro I receive "Run-time error '1004': PasteSpecial method of Range class failed." The issue seems to be with the first line stating:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I have a collection of paste special code in this module so I am afraid that this first line might not be the only issue. Below is the code I have so far.
Sub PlaceOrder()
'
' PlaceOrder Macro
'
'
Range("A3").Select
Selection.Copy
Range("Table1[[#Headers],[Balance]]").Select
Selection.End(xlDown).Select
Selection.ListObject.ListRows.Add AlwaysInsert:=False
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Range("A1").Select
Range("C3:E3").Select
Application.CutCopyMode = False
Selection.Copy
Range("C23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 3).Range("A1").Select
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Range("F23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 3).Range("A1").Select
Range("E3").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D3").Select
Selection.ClearContents
Range("C3").Select
Selection.ClearContents
Range("B3").Select
Selection.ClearContents
Selection.ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:= _
"en-US"
End Sub
Any help will is greatly appreciated!
Edit:
Worksheet
Attached is screenshot of the worksheet I am working with. I would like to be able to paste the values of A3 & C3-F3, and the formula in B3 into the table seen below. A new row needs to be inserted prior to pasting all of this information.

This should work. It's basically just a clearer version of your code.
Sub PlaceOrder()
Dim tbl As ListObject
Dim LastRow As Long
Set tbl = ActiveSheet.ListObjects("Table1")
LastRow = tbl.Range.Rows.Count 'get # of last row
With ActiveSheet
'copy and paste A3
.Range("A3").Copy
tbl.Range(LastRow, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'copy and paste B3
.Range("B3").Copy
tbl.Range(LastRow, 2).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
'copy and paste C3:F3
.Range("C3:F3").Copy
tbl.Range(LastRow, 3).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'clear value in B3:F3
.Range("B3:F3").ClearContents
End With
End Sub
Your original macro did not work because the system forgot the copied value after this line:
Selection.ListObject.ListRows.Add AlwaysInsert:=False

Related

Cells not being copied to the next available cell

I am trying to record a macro that copies values from 4 cells then pastes them on another sheet that serves as a sort of log. I cannot get the values to paste in a new row though despite using the "Relative References" button when recording the macro. Is there something I can add to the code below to make the values paste in the next available row?
'''
Sub Again()
'
' Again Macro
'
'
Range("B5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, -3).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Test").Select
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
'''
Sub add_value()
Dim wbA As Workbook
Dim wsA As Worksheet
Set wbA = ActiveWorkbook
Set wsA = wbA.Worksheets("Sheet1")
Dim nrow As Long
nrow = 6
Do Until wsA.Range("B" & nrow).Value = ""
wsA.Range("B" & nrow).Value = wsA.Range("B3").Value
wsA.Range("C" & nrow).Value = wsA.Range("C3").Value
Exit Sub
nrow = nrow + 1
Loop
End Sub
This is actually working, now i just have to figure out how to offset it

Excel VBA (sub or function not defined error)

I am working on the following code in VBA excel and i get the compile error "sub or function not defined"
The code is meant to copy the cells and paste their transpose at a certain offset.
Any help would be highly appreciated.
Code
Sub copy_paste()
ActiveCells.Copy
Offset(-1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Offset(3, -1).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Offset(-2, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Offset(1, 0).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.ClearContents
End Sub
Thanking in advance, here is the code along with the error:
Try this code, please. It avoids selecting, which consumes Excel resources, without any benefit. Offset makes sense only if it references a range:
Sub testCopy()
Dim sh As Worksheet, rng As Range
Set sh = ActiveSheet 'use here your sheet
Set rng = ActiveCell 'use here what range you need
rng.Copy
rng.Offset(-1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
sh.Range(rng.Offset(3, -1), rng.Offset(3, -1).End(xlToRight)).Copy
rng.Offset(-2, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
sh.Range(rng.Offset(1, 0), rng.Offset(1, 0).End(xlToRight)).ClearContents
End Sub
Use offset in vba like this : Range("A1").Offset(1, 1).Select .
in your code you used offset without refrence range address

VB to Post to New Line per Button Click

I recorded a macro, linked to a button, on say sheet1. The object of what I need done:
When the button is pressed, certain cells are selected and copied to a "summary" page on another sheet.
Sheet1 has a drop down that shows certain information. So after data is selected from the drop down, the user will push the button and post that data to the summary sheet.
The macro works fine (please note I am a VBA noob), but I need assistance in adding functionality that after every button press, it copies the data on the next line - in other words, if data is in row 1 already, it must place the data in row 2, and so on.
The VB code I have is as follows:
Sub Test()
'
' Test Macro
'
'
Range("C32:N32").Select
Selection.Copy
Sheets("Summary").Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Sheets("Comm Payable").Select
Range("C3:D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Sheets("Comm Payable").Select
Range("N1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Range("B4").Select
Sheets("Comm Payable").Select
Range("O1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("O1").Select
End Sub
Please could someone assist with the addition described above?
Much appreciated!
It's imperative you read the link posted by PEH as you can considerably shorten and speed up your code. I think this does what you want.
Sub Test()
Dim r As Long
r = WorksheetFunction.Max(Sheets("Summary").Range("D" & Rows.Count).End(xlUp).Row + 1, 3)
Sheets("Comm Payable").Range("C32:N32").Copy
Sheets("Summary").Range("D" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("C3:D3").Copy
Sheets("Summary").Range("B" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("N1").Copy
Sheets("Summary").Range("C" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("O1").ClearContents
End Sub
As an aside, transferring values directly is more efficient than copying and pasting and here is an example of that.
With Sheets("Comm Payable").Range("C32:N32")
Sheets("Summary").Range("D" & r).Resize(.Rows.Count, .Columns.Count).Value = Value
End With

VBA Code to copy & paste ranges of data from one sheet to another based on date (as criteria)

I recorded the following macro and then edited the code to include a condition, but the code is not working as it is. And when I remove the 2nd IF argument the data is copied in all columns in the distination sheet. Wereas my objective is to copy the data only if the date in the columns headers are matching. Basically I values in sheet "Daily Input Form" in a simple tab and I want to have it copied in the "Daily Cash Flow" sheet (which has multiple columns) only if the date in the header of specific column matches the date in the "Daily Input Form" sheet...(which is simply the formula "Today()".
I know there is a much simpler way to write the code but I'm a novis to the VBA, so appreciate if you can help me out.
Thanks
Sub RangeCopy1()
'
' RangeCopy1 Macro
Dim lRow As Range, Cell As Object
Set lRow = Sheets("Daily Cash Flow").Range("E13:AV13")
For Each Cell In lRow
If Cell.Value = "YES" Then
Sheets("Daily Input Form").Select
Range("D7:D12").Select
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E36:AV36").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("D15:D25").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E43:AV43").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("D28:D34").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E56:AV56").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("H7:H23").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E68:AV68").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("H26:H63").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E86:AV86").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Daily Input Form").Select
Range("H66:H86").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Daily Cash Flow").Select
Range("E125:AV125").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
If Cell.Value = "" Then
Exit Sub
End If
Next
End Sub

Looping until cell is empty

I have my macro written but now I need it to run in a loop until cell I2 is empty.
Can anyone help with this?
Sheets("Value Imported Data").Select
Range("I2:Q2").Select
Selection.Copy
Sheets("Good data").Select
Range("I1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Value Imported Data").Select
ActiveCell.Resize(40, 9).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
I assumed it would be something like this but it does not work at all
Sub CandidatesInfo()
Dim r As Range
Dim Cell As Range
Sheets("Value Imported Data").Select
Set r = Range("I2")
For Each Cell In r
If r.Notempty Then
Range("I2:Q2").Select
Selection.Copy
Sheets("Good data").Select
Range("I1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Value Imported Data").Select
ActiveCell.Resize(40, 9).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
Next
End Sub
Basically what I want to do is if I2 is empty do nothing but if it is not empty copy I2 to Q2 into another sheet and once copied go back in the sheet where the information was copied and delete the next 40 information down and 9 to the right and start over again. As I said the top macro works perfectly, now it is just a matter of starting over and over until I2 is empty.
Any help is appreciated.
Thank you very much

Resources