How to save and transpose a range in Excel VBA - excel

I have a macro where I open a textfile to copy and transpose several columns into my worksheet. As it is now this actually works. However, as I am right now opening the textfile, copying a column, going back to my original worksheet pasting and transposing the data, then switching back and forward between the two sheets until all relevant columns have been copied I figured it could probably be optimized if I understood VBA a little better.
So my question is if I can save the column data as ranges instead and then copying it all at once and pasting and transposing it all at once as well?
Or will this not have any impact on the speed of my macro?
Also, as I am actually opening many textfiles (open one, close it, open the next, close it, etc) is it possible to overwrite a range when a new textfile has been opened?
I have shown an example of my code below hope you can make sense of it:
'First Selection to be copied
ActiveSheet.Cells(RowTemp + 1, 1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Go back to original sheet
Windows(Left(f, Len(f))).Activate
'Paste and Transpose Data
If IsEmpty(ActiveSheet.Cells(4, 2).Value) = True Then
ActiveSheet.Cells(4, 1).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveSheet.Cells(4 + 5 + Range("A2").Value, 1).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
'Copy 2nd set of Data
Windows(Left(z, Len(z))).Activate
Range("B1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(Left(f, Len(f))).Activate
'Paste and Transpose 2. set of data
If IsEmpty(ActiveSheet.Cells(5, 2).Value) = True Then
ActiveSheet.Cells(5, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
ActiveSheet.Cells(5 + 5 + Range("A2").Value, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If

Related

VBA Macro for Pasting Data In New Row of Table - 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

VBA Fixed workbook to various workbooks

I think I'd like to do my everyday things easier. I do not have any wide knowleadge of VBA so i use it with "record VBA".
I have 2 workbooks:
(1) "DATABASE.xlsx" - fixed which always collect data
(2) many workbooks i.e. "xxx.xlsx" , "yyyy.xlxs", "zzzz.xlsx" etc. - variable workbook, changing every time depends on what i copy from the workbook (1) - I will open (2) manually by myself
My issue is how to write my VBA to copy data from (1) to various workbooks (2). I do not know how to define the (2) workbooks which alwyas change. I can choose (2) workbooks manually. It does not have to be something really professional. It's only about coping from (1) to (2)....
I have done as below:
Sub Makro10() ' ' Makro10 Makro ' ' Klawisz skrótu: Ctrl+Shift+X '
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 2).Range("A1:H1").Select
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Offset(0, 9).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 1).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 3).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("xxx.xlsx").Activate
ActiveCell.Offset(0, 14).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False End Sub
It's working for only specific (2) workbook "xxx.xlsx", but i would like to use it for various (2).
I'm asking for support, thanks in advance.
The easiest way to achieve this is by replacing all the instances of Windows("xxx.xlsx").Activate with Workbooks(2).Activate in your code.
But you have to make sure that no other workbooks are open as the code can accidentally reference another workbook based on how you opened excel files. So technically, you need to open workbook (1) first which is DATABASE.xlsx. Then open whichever workbook (2) you need and run the code.
Sub Makro10() ' ' Makro10 Makro ' ' Klawisz skrótu: Ctrl+Shift+X '
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 2).Range("A1:H1").Select
Selection.Copy
Workbooks(2).Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(2).Activate
ActiveCell.Offset(0, 9).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 1).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(2).Activate
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("DATABASE.xlsx").Activate
ActiveCell.Offset(0, 3).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(2).Activate
ActiveCell.Offset(0, 14).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False End Sub
What is happening here is that VBA references the 2nd workbook that was opened (which is workbooks(2)) and pastes the data there as per the code. in your earlier code, because you recorded it, it was always using xxx.xlsx file because that is how you recorded it.
I would suggest that if possible save the code in DATABASE.xlsx and save the file as a macro file (DATABASE.xlsm). That way, you can open workbook (1) and workbook (2) (whichever one you want) and run the code from workbook (1).
Hope this helps! Happy coding!
Sub Makro2()
'
' Makro2 Makro
'
' Klawisz skrótu: Ctrl+Shift+X
'
Dim OthWB As String
Windows.Application.ActiveSheet.Select
OthWB = ActiveWorkbook.Name
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 2).Range("A1:H1").Select
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 8).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Offset(0, 9).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 1).Range("A1:C1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Offset(0, 7).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("202102 PO.xlsx").Activate
ActiveCell.Offset(0, 3).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(OthWB).Activate
ActiveCell.Offset(0, 14).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
#Bharath Raja
Thanks for your answer. I will try your solution also
I was thinking also about issue & found the resolve. We must active (2) workbook & then it is defined as OthWB. Maybe somebody uses it also.

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

Paste figures avoiding formulas on target

I have a macro to copy and paste values into different columns in my spreadsheet. On the target columns I have some formulas that I need to avoid to override when the macro paste the values as I actually want the formula to calculate the new values. I have a code created already, but I would really appreciate you help adding the condition to avoid pasting where there are formulas on the target.
Sub RawDataNew()
'
' RawDataNew Macro
' To move validated to previous week on raw data tab
'
Range("$B$17:$AQ$2572").AutoFilter Field:=6
Range("Z18:AB2572").Select
Selection.Copy
Range("AU18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H18:H2572").Select
Selection.Copy
Range("AR18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("O18:O2572").Select
Application.CutCopyMode = False
Selection.Copy
Range("AS18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W18:W2572").Select
Selection.Copy
Range("AX18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("X18:X2572").Select
Application.CutCopyMode = False
Selection.Copy
Range("AY18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G4").FormulaR1C1 = "=TODAY()"
Range("G4").Value = Date
Range("G5").Value = Environ("username")
'
End Sub
The paste method you're using Paste:=xlPasteValues is only pasting the values; if you want formulas as well as values, you'll need Paste:=xlPasteAll.
If you ONLY want formulas, you'll need Paste:=xlPasteFormulas
Please refer to link for other optional parameters
Another suggestion is using the = method ie.
Range("A1").value = Range("B1").value
As the copy/paste method is very slow, especially when you have as much data as you're using here now. Also, you'll get all the extra formatting from the copied cells, which can be quite annoying to deal with

Excel VBA Copying and Pasting into Next Blank Row in Another Sheet

I'm trying to record a macro using keystrokes only and am coming across an issue on my final keystroke as it is not doing what I expect it to be. A little background in what I am doing - I am working with growing data and a rolling graph to graph the last 4 rows of data. I am trying to copy data from one sheet and paste it onto the next empty row on my table in another sheet. Because I'm using keystrokes, I expected the macro to record the number of clicks but this is not what it's doing. Instead it pastes the data right over the exact cell that the macro was recorded in and not the empty cell below it. For example, I have data in C19 already. When I run the macro, I expect it to paste the new data into C20 but instead it pastes over C19. I think I need to add/edit my VBA so that it will paste the new data into the next empty row in another sheet. I hope this made sense. Any help will be much appreciated!
Thank you!!
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Range("C3").Select
ActiveCell.FormulaR1C1 = "=DATE(YEAR(RC[-1]), MONTH(RC[-1])+1, DAY(RC[-1]))"
Range("C3").Select
Selection.Copy
Range("B3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("C3").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("B85:K146").Select
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("B9").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
ActiveSheet.Next.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Range("E71:G71").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select
ActiveSheet.Next.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
Selection.End(xlToLeft).Select
Range("C5").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("C19").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
As others have commented it's best if you read up on how to code directly rather than record a macro. As a quick fix though this should help:
Replace this:
Range("C19").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
with this:
Cells(Range("C1000000").End(xlUp).Row + 1, 3).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
What the .End(xlUp) does is to go from row 1,000,000 upwards looking for the first cell that contains something. The .Row gets the row it's on and the + 1 means we want the next row. Cells is another way of expressing a Range, look up Range and Cell on-line, it will help you on your way.

Resources