Paste transposed data to new row - excel

I am trying to create a form in excel in Sheet 1 (named Form) where the data copied from Sheet 1 (Form) is pasted to Sheet 2 (Data).
The form is vertical; however, the data is horizontal.
As such, I am using PasteSpecial.
When I use the macro button to paste and clear the data from the "Form" to the "Data", it is works for the first and second use. On the third use, the data is pasted on the second set of data rather than in a new row.
Sub Submit()
'
' Submit Macro
'
'
Range("C2:C14").Select
Selection.Copy
Sheets("Data").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("A3").Select
Sheets("Form").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C2").Select
End Sub

Does this work?
Sub Submit()
Sheets("Form").Range("C2:C14").Copy
Sheets("Data").Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End Sub
You can read this to find out how to avoid using Select/Activate.

Related

Multiple copy values + call macro not working

I recently started to work with macros and I am trying to copy a selection from a sheet, paste it in the same sheet and to repeat this in the whole workbook.
The problem is that only in the first sheet the values are copied.
I also linked the macros to a button and all macros are in the same module; you can see my sketch below:
Sub CopyValues_sheet1()
'
' CopyValues_sheet1 Macro
'
'
Range("C6:AD47").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=18
Range("C53:AD94").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Sub CopyValues_sheet2()
'
' CopyValues_sheet2 Macro
'
'
Range("C6:AD47").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=50
Range("C53").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C60").Select
End Sub
Sub Button1_Click()
Call CopyValues_sheet1
Call CopyValues_sheet2
End Sub
The way you're doing this, you need to activate the sheet where you wish to complete the copy/paste operation. Something like this:
Sub CopyValues_sheet2()
'
' CopyValues_sheet2 Macro
'
Sheet2.Activate ' <--- Do this!
Range("C6:AD47").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=50
Range("C53").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C60").Select
End Sub
If you're doing the exact same thing on every sheet, you might want to parameterize your sub/function with a sheet name, and use something like this:
Worksheets("Your_worksheet_name").Activate

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 macro for copying a sheet, then copying some info from another sheet into the copied sheet

I'm having problems getting this to work. I just want to copy the second sheet from the left before the first sheet. Then copy info from what just became the second sheet to the new left most sheet. I get an error on SELECTION.Copy stating there is an expected variable missing.
Sub GenerateInvoice()
Sheets(2).Select
Sheets(2).Copy Before:=Sheets(1)
Sheets(2).Select
Range("H2:N2").Select
SELECTION.Copy
Sheets(1).Select
Range("E11").Select
SELECTION.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Do you have any hidden sheets or non-worksheet sheets (chart sheets for example)?
You generally don't need select/activate:
Sub GenerateInvoice()
Sheets(2).Copy Before:=Sheets(1)
With Sheets(2).Range("H2:N2")
Sheets(1).Range("E11").Resize(1, .Columns.Count).Value = .Value
End With
End Sub

looping copy from multiple rows pasting them individually in the same row....

.....on a separate workbook indefinitely.
Hello First off I am new here and very new to VBA. I have a workbook that has a list that will grow indefinitely named "book1" and the code i pieced together grabs data from a range in that book and pastes it into another book "DMAutocalcs"in one specific row one at a time and the the code executes a refresh and wait time, after which it copy certain pricing date from a specific range in "DMautoCalcs" back into Book1. As of Now i am manually copying the code and modifying it for each range of calls it needs to transfer. so there in lies the issue, inherently it will be limited by the number of times i wish to copy what i have existing. I intend to modify the code to loop and perform the copy paste between the workbooks until it reaches an empty cell in "book1" however every attempt i have made has failed, it only continually works the same ranges over and over unless i manually copy the code and modify for each new line. i fear i do not fully understand the range rows and cell aspects when it comes to relatives and absolutes and the proper syntax on how to call the out accurately.
how do i achieve this? Any help would be appreciated.
Public Sub macro_54()
' Keyboard Shortcut: Ctrl+p
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Workbooks.Open ("C:\Users\Legacy\Desktop\DMAutoCalcs.xlsm")
Windows("Book1.xlsm").Activate
Range("a2:l2").Select
Selection.Copy
Windows("DMAutoCalcs.xlsm").Activate
Range("a1:q1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Refresh
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:03"))
ActiveWorkbook.RefreshAll
Windows("DMAutoCalcs.xlsm").Activate
Range("T2:x2").Select
'Application.CutCopyMode = False
Selection.Copy
Windows("Book1.xlsm").Activate
Range("M2:q2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copy from calcs pricing info and past into pricelist
' return to pricelist
' Selects cell down 1 row from active cell.
'New Line
Windows("Book1.xlsm").Activate
Range("a3:l3").Select
Selection.Copy
Windows("DMAutoCalcs.xlsm").Activate
Range("a1:q1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Refresh
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:03"))
ActiveWorkbook.RefreshAll
Windows("DMAutoCalcs.xlsm").Activate
Range("T2:x2").Select
'Application.CutCopyMode = False
Selection.Copy
Windows("Book1.xlsm").Activate
Range("M3:q3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copy from calcs pricing info and past into pricelist
' return to pricelist
' Selects cell down 1 row from active cell.
'New Line
Windows("Book1.xlsm").Activate
Range("a4:l4").Select
Selection.Copy
Windows("DMAutoCalcs.xlsm").Activate
Range("a1:q1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Refresh
ActiveWorkbook.RefreshAll
Application.Wait (Now + TimeValue("0:00:03"))
ActiveWorkbook.RefreshAll
Windows("DMAutoCalcs.xlsm").Activate
Range("T2:x2").Select
'Application.CutCopyMode = False
Selection.Copy
Windows("Book1.xlsm").Activate
Range("M4:q4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copy from calcs pricing info and past into pricelist
' return to pricelist
'
' Selects cell down 1 row from active cell.
' And so on and so forth....
Windows("DMAutoCalcs.xlsm").Activate
ActiveWorkbook.Close savechanges:=False
Windows("Book1.xlsm").Activate
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
MsgBox "All Ranges Updated, Calc sheet closed successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
You need not to select or activate a range or window before copying and pasting. Below is the modified code from I can understand you.
Sub macro_54_Modified()
'Let your working sheets in Book1 and DMAutoCalcs are Sheet1 and Sheet2, respectively
Workbooks.Open "C:\Users\Legacy\Desktop\DMAutoCalcs.xlsm"
Dim wsDm As Worksheet, wsB1 As Worksheet, lastRow As Long, i As Long
Set wsB1 = Workbooks("Book1.xlsm").Sheets("Sheet1")
Set wsDm = Workbooks("DMAutoCalcs.xlsm").Sheets("Sheet2")
'Last row number in column A
lastRow = wsB1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
wsB1.Range("A2:L2").Offset(i - 2).Copy wsDm.Range("a1:q1")
'VBA code for Refresh ... ?
wsDm.Range("T2:X2").Copy wsB1.Range("M2:q2").Offset(i - 2)
Next i
End Sub

VBA script to copy Data from specfic cell range and paste to a specific cell in a new sheet

I have the following script and am trying to work out how to paste the copied data to cell AA1 in sheet TEST, But before it pastes the selected data i need to clear all the data that is in columns AA:AK in sheet TEST. The script copies the data ok but i can't get Selection.PasteSpecial to work with "offset", and i cant work out how to clear the contents of AA:AK in advance.
Any help would be much appreciated.
Sub CopyDATA()
' Set Auto Filter
Selection.AutoFilter
Sheets("SBC_Month").Select
Range("$AA$1:$AK$5000").AutoFilter Field:=9, Criteria1:="Rep Name" ' Filters by Rep Name
' copy filtered data
Range("AA1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
' Paste to sheet Test
Sheets("TEST").Select
Selection.PasteSpecial , Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
You should be able to use
Sub CopyDATA()
Sheets("TEST").Range("AA:AK").ClearContents
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
' Paste to sheet Test
Sheets("TEST").Range("AA1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

Resources