I am trying to copy a range of cells in a single column and transpose them above
as a row.
The problem I am having is to try to increase the Rows(45:45) where each row is being copied, otherwise all of the rows get overwritten.
When I run the macro I get a syntax error on Destination:= Range line
Range("A53:A63").Copy
Range("A52").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Range("A53:A63").Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Rows("52:52").Cut
Rows("45:45").Select
Destination:=Range("A" & Rows.Count).End(xlDown).Offset(1, 0)
Selection.Insert
Although I do not really understand what you are trying to do but maybe this helps.
Sub test()
Range("A53:A63").Copy
Range("A52").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Range("A53:A63").Select
Application.CutCopyMode = False
Selection.ClearContents
Rows("52:52").Copy
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Related
I am trying to copy and paste certain cells that are not in the same column or row and paste them in Specific columns (it will be the same columns everytime). Once each entry is done, I want the next set of entries to paste on the next available row. The first set of code for Paste_NextRow() was ran as a macro and this was the code that was returned. The ranges I selected have formulas in them that will have different values each month. I am pasting them in a row with headers in row A. The second set of code for LastRow() I found this online and it will return the last row that is empty. I'm unsure how to utilize the second set of code to paste in the next available row. If you need additional context in order to help modify the code please let me know. Thanks. I've edited the text to show the code accordingly.
Sub Paste_NextRow()
'
' Paste_NextRow Macro
'
'
Sheets("SUMMARY DATA SHEET").Select
Range("F3").Select
Selection.Copy
Sheets("Invoice Number").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SUMMARY DATA SHEET").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Invoice Number").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SUMMARY DATA SHEET").Select
Range("B4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Invoice Number").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SUMMARY DATA SHEET").Select
Range("F4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Invoice Number").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SUMMARY DATA SHEET").Select
Range("F5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Invoice Number").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A3").Select
End Sub
Sub LastRow()
NextRow = ThisWorkbook.Sheets("Invoice Number").Cells(Rows.Count, 2).End(xlUp).Row + 1
End Sub
Here is a quick rewrite setting a variable (called lastRow) to the last row in your invoice number tab.
Sub Paste_NextRow()
'
' Paste_NextRow Macro
'
'
'Get the last used row into a variable
Dim lastRow as Long
lastRow = ThisWorkbook.Sheets("Invoice Number").Cells(Rows.Count, 2).End(xlUp).Row + 1
'Copy Summary Data Sheet F3
Sheets("SUMMARY DATA SHEET").Range("F3").Copy
'And paste it into the last row (column F) of Invoice Number sheet
Sheets("Invoice Number").Range("F" & LastRow).Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Use similar logic for the remaining cells
Sheets("SUMMARY DATA SHEET").Range("F2").Copy
Sheets("Invoice Number").Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SUMMARY DATA SHEET").Range("B4").Copy
Sheets("Invoice Number").Range("B" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SUMMARY DATA SHEET").Range("F4").Copy
Sheets("Invoice Number").Range("D" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("SUMMARY DATA SHEET").Range("F5").Copy
Sheets("Invoice Number").Range("E" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
You'll see that there are no .Select happening here since Selecting a sheet or a cell is something a human does. There really isn't a need to do that in VBA where instead we can just specify exactly what we want to copy and where we want to paste it.
While this is cleaned up, it's still a little cumbersome to just copy and paste VALUES around the workbook. It uses the clipboard and has multiple statements for each copy/paste.
Instead we can just set the value of one cell equal to the value of another cell:
Sub Paste_NextRow()
'
' Paste_NextRow Macro
'
'
'Get the last used row into a variable
Dim lastRow as Long
lastRow = ThisWorkbook.Sheets("Invoice Number").Cells(Rows.Count, 2).End(xlUp).Row + 1
Sheets("Invoice Number").Range("F" & LastRow).Value = Sheets("SUMMARY DATA SHEET").Range("F3").value
Sheets("Invoice Number").Range("C" & lastRow).value = Sheets("SUMMARY DATA SHEET").Range("F2").value
Sheets("Invoice Number").Range("B" & lastRow).Value = Sheets("SUMMARY DATA SHEET").Range("B4").value
Sheets("Invoice Number").Range("D" & lastRow).Value = Sheets("SUMMARY DATA SHEET").Range("F4").value
Sheets("Invoice Number").Range("E" & lastRow).Value = Sheets("SUMMARY DATA SHEET").Range("F5").value
End Sub
Lastly, typing out those worksheet names over and over again is cumbersome. We can use a couple of variables to hold the two worksheets we care about. This is nice if you ever want to change worksheet names as you only have one place in the code to make the change:
Sub Paste_NextRow()
'
' Paste_NextRow Macro
'
'
'Set some variables to hold our worksheets
Dim wsCopy as Worksheet
Dim wsPaste as Worksheet
Set wsCopy = Sheets("SUMMARY DATA SHEET")
Set wsPaste = Sheets("Invoice Number")
'Get the last used row into a variable
Dim lastRow as Long
lastRow = ThisWorkbook.Sheets("Invoice Number").Cells(Rows.Count, 2).End(xlUp).Row + 1
'Copy values over
wsPaste.Range("F" & LastRow).Value = wsCopy.Range("F3").value
wsPaste.Range("C" & lastRow).value = wsCopy.Range("F2").value
wsPaste.Range("B" & lastRow).Value = wsCopy.Range("B4").value
wsPaste.Range("D" & lastRow).Value = wsCopy.Range("F4").value
wsPaste.Range("E" & lastRow).Value = wsCopy.Range("F5").value
End Sub
Why can´t my code below paste values only?
The result is pastes the formula instead of the value.
Can anyone help?
Please check my code as follow :
Sheets("Invoice Print").Activate
Range("F21:F27").Select
Selection.SpecialCells(xlCellTypeFormulas, 1).Select
Selection.Copy
Sheets("Outgoing Goods").Select
Cells(Rows.Count, 1).Range("K1").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Are there any mistakes?
PS: I'm using Excel 2013.
Please advise.
Thank you.
You overwrite the pasted values right in the next line with ActiveSheet.Paste
Also you should not use .Select and Selection..
Sheets("Invoice Print").Range("F21:F27").SpecialCells(xlCellTypeFormulas, 1).Copy
With Sheets("Outgoing Goods")
.Cells(.Rows.Count, 1).Range("K1").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'This line would overwrite the pasted values with not explecit values only
'ActiveSheet.Paste
Application.CutCopyMode = False
End With
Hope I could help.
Sub TryAgainPrint3()
'
' TryAgainPrint3 Macro
'
'
ActiveCell.Range("A1:H1").Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("Print").Select
ActiveCell.Offset(-3, -2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Problems").Select
ActiveCell.Offset(0, 8).Range("A1:I1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Print").Select
ActiveCell.Offset(2, 0).Range("A1:I1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Problems").Select
Range("V5").Select
ActiveCell.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Print").Select
ActiveCell.Offset(1, 2).Range("A1").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
To have the subroutine exit if the user hasn't selected a cell in column E, you can add the following If statement to the top of your code:
If ActiveCell.Column <> 5 Then
MsgBox ("Select a cell in Column E")
Exit Sub
Else:
End If
Does that get you what you need? You can specify any column, just bear in mind you need to use the column index, not the column itself. Column E = column 5
I'm very new to VBA (as of this morning), so excuse my ignorance. I have a few hundred Excel workbooks, all formatted exactly the same way (just with different text). I'm trying to both format and delete a few sheets within the workbooks (the same for alL).
I recorded a macro that works fine when applied individually, but I'm getting a runtime error when I try to run this as a means of mass format:
Sub LoopFiles()
Dim MyFileName, MyPath As String
Dim MyBook As Workbook
MyPath = "I:\Academic Networks\All scorecard copies, 6.18.2015"
MyFileName = Dir(MyPath & "*.xlsm")
Do Until MyFileName = ""
Workbooks.Open MyPath & MyFileName
Set MyBook = ActiveWorkbook
Application.Run "Workbook1.xlsm!ScorecardMacro"
MyBook.Save
MyBook.Close
MyFileName = Dir
Loop
End Sub
I keep getting a runtime error (9) - Subscript out of range. Any thoughts?
Here's the formatting/deleting I'm trying to apply to all my workbooks (which works fine when applied to one workbook at a time:
Sub ScorecardMacro()
'
' Scorecard Macro
'
'
Sheets.Add
Sheets("Scorecard").Select
Range("D3:D36").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Sheets("Scorecard").Select
Range("A3:A36").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Sheets("Scorecard").Select
Range("F3:I36").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Checklist").Select
Range("D4:D27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveWindow.ScrollColumn = 28
Range("AJ1").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Sheets("Checklist").Select
Range("A4:A27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("AJ2").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Sheets("Additional Information").Select
Range("A4:B14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("BH1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Program Recommendations").Select
Range("A4:D21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("BS1").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
ActiveWindow.ScrollColumn = 1
Range("A2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1,SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A6"), Type:=xlFillDefault
Range("A2:A6").Select
Sheets("Program Recommendations").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Additional Information").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Scorecard").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Checklist").Select
ActiveWindow.SelectedSheets.Delete
End Sub
The error shows you are trying to access something that doesn't exist.
Since you are deleting something, its better to do all you updates first, then do all the deletes in the end.
If you do some deletes in between and then update, there might be some values/sheets missing
You are referring to a named range called "filename":
"=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1,SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1)"
I suspect that name is not defined in the other workbooks.
I need to write a Loop to run the following lines until the third line finds the cell it is selecting to be empty.
I would normally include my code for the loop to be corrected / critiqued but after searching all morning I can't find an example of do while loop that doesn't count to keep moving.
Can someone point me in the right direction with a link or two?
Sheets("Sheet1").Select
Selection.Offset(0, 3).Select
Selection.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection(1, 3)).Select
Selection.Copy
Sheets("Output").Select
Selection.End(xlDown).Select
Selection.Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Include Fund name
Sheets("Sheet1").Select
Selection.End(xlUp).Select
Selection.Copy
Sheets("Output").Select
Range("B2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Offset(0, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Offset(0, -1).Select
Selection.FillDown
I can't find an example of do while loop that doesn't count to keep moving.
You didn't look very hard, then. All Do or While loops should have a terminator, or an Exit statement, otherwise they will crash the application in an infinite loop.
Try:
Do Until Sheets("Sheet1").Selection.Offset(1, 0).Value = vbNullString
'// YOUR CODE HERE //
Loop
Or:
Do
If Sheets("Sheet1").Selection.Offset(1, 0).Value = vbNullString Then Exit Do
'// YOUR CODE HERE //
Loop