I'm looking to select cells with values from a dynamic table, and copy and paste these values into another worksheet with a table where the next empty cell is available.
I've only been able to find code that will copy and paste a defined range into the next empty cell or copy and paste a dynamic range with some values and empty cells.
Sub SaveKit_1()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopy As Long
Dim lDest As Long
Set wsCopy = Worksheets("Kit_db") 'Copies table from Kit_db worksheet
Set wsDest = Worksheets("Kit_db (1)") 'Pastes table to Kit_db (1) worksheet
lCopy = wsCopy.Cells(wsCopy.Rows.Count, "E").End(xlUp).Row
lDest = wsDest.Cells(wsDest.Rows.Count, "E").End(xlUp).Offset(1).Row
'Copies any cell within the table
wsCopy.Range("B3:I" & lCopy).Copy _
wsDest.Range("B" & lDest)
End Sub
All cells in the dynamic table are copied and pasted rather than the cells in the table with values. I'm looking to paste values only as some cells in the dynamic table have formulas.
I have tried the following Paste Special
PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlPasteSpecialOperationNone, _
SkipBlanks:=True, _
Transpose:=False
But I don't think I placed it correctly with the existing code or I'm using the wrong type of code for paste.
Here is an example of paste special as values with your code
Sub SaveKit_1()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopy As Long
Dim lDest As Long
Set wsCopy = Worksheets("Kit_db") 'Copies table from Kit_db worksheet
Set wsDest = Worksheets("Kit_db (1)") 'Pastes table to Kit_db (1) worksheet
lCopy = wsCopy.Cells(wsCopy.Rows.Count, "E").End(xlUp).Row
lDest = wsDest.Cells(wsDest.Rows.Count, "E").End(xlUp).Offset(1).Row
'Copies any cell within the table
wsCopy.Range("B3:I" & lCopy).Copy
wsDest.Range("B" & lDest).PasteSpecial xlPasteValues
End Sub
Related
I have the following code and would like to change it so that if the cells from A2 to H2 are empty in Sheet1 then the macro doesn't do anything (it's part of a larger sub so I don't want to exit sub completely), however, if there is anything in these cells than the macro is executed.
This is my current code, the problem that I have is that it copies the area under the headers of a table and if the area is empty then it copies the headers.
Sub Macro36()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column 1
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.count, "A").End(xlUp).Row
'2 Find first bnak row in the destination range based in column A
lDestLastRow = wsDest.Cells(wsDest.Rows.count, "B").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy wsDest.Range("B" & lDestLastRow)
End Sub
This is my attempt to change the code by adding if function, however, the macro is still executed even though cells A2:H2 in Sheet 1 are empty.
Sub Macro36()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
'Set variables for copy and destination sheets
Set wsCopy = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")
'1. Find last used row in the copy range based on data in column 1
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.count, "A").End(xlUp).Row
'2 Find first bnak row in the destination range based in column A
lDestLastRow = wsDest.Cells(wsDest.Rows.count, "B").End(xlUp).Offset(1).Row
'If function
If IsEmpty(Sheets("Sheet1").Range("A2:H2")) = False Then
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy wsDest.Range("B" & lDestLastRow)
Else
Range("A1").Select
End if
End Sub
I was wondering how I could change the code?
Thanks,
I'm trying to make something in Excel work, but I cannot.
I have 2 Sheets
Sheet 1 is the "main sheet"
Sheet 2 has a filter.
I want 2 filtered columns to be copied to the main sheet and pasted at the end of the already existing content.
Try this - you will need to update the ranges/sheet names as required.
Sub CopyDataLastRow()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
'Set Variables
Set wsCopy = Sheets("Sheet1") 'Update your sheet name as required.
Set wsDest = Sheets("Sheet2") 'Update your sheet name as required.
'Find Last Row in Copy Range
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'Find 1st blank row in Destination Range - Offset 1 row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
'Copy & Paste Data
wsCopy.Range("A2:B" & CopyLastRow).Copy _
wsDest.Range("A" & DestLastRow)
End Sub
My goal is to copy and paste from one workbook to another, but I want to have dynamic names - now are statitic and declared in code.
From the code below is visible how it is set now. How can i change my code so these names will be automatic based on the cell (eg.: destination now is "ToThere.xslx" to a value that is in a cell "O2")
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Name as Short
Name = Range("O2").Value
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("FromHere.xlsm").Worksheets("List1")
' I would like this part here to be: Workbooks(Name).Worksheets("List1")
Set wsDest = Workbooks("ToThere.xlsx").Worksheets("List1")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in
column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count,
"A").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy _
wsDest.Range("A" & lDestLastRow)
Here's your example
Sub test()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Dim Name As Integer
Name = Range("O2").Value
'Set variables for copy and destination sheets
Set wsCopy = Workbooks("FromHere.xlsm").Worksheets("List1")
' I would like this part here to be: Workbooks(Name).Worksheets("List1")
Set wsDest = Workbooks("ToThere.xlsx").Worksheets("List1")
'1. Find last used row in the copy range based on data in column A
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
'2. Find first blank row in the destination range based on data in
'Column A
'Offset property moves down 1 row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
'3. Copy & Paste Data
wsCopy.Range("A2:H" & lCopyLastRow).Copy
ActiveSheet.Paste Destination:=wsDest.Range("A" & lDestLastRow)
End Sub
As shown the mocked-up table above, i'm trying write a macro that copies new data from another workbook (OtherWorkBook), then pastes it below the existing database (in ThisWorkBook).
After that, for only the new rows of data that was pasted, i want to shift the values in columns A, B, C, D one cell to the right. My current code works right until when it is supposed to move the columns, but then an error shows up.
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim ToCopy As Range
Dim ToPaste As Range
Set wsCopy = Workbooks("OtherWorkBook").Worksheets("OtherWorkSheet")
Set wsDest = Workbooks("ThisWorkBook").Worksheets("ThisWorkSheet")
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
wsCopy.Range("A2:V" & CopyLastRow).Copy _
wsDest.Range("A" & DestLastRow)
Set ToCopy = wsCopy.Range("A2:V" & CopyLastRow)
Set ToPaste = wsDest.Range("A" & PasteToLastRow)
ToCopy.Copy ToPaste
Set ToPaste = ToPaste.Resize(ToCopy.Rows.Count, ToCopy.Columns.Count)
ToPaste.Columns("A:D").Cut
'The debugger highlights this line of code
ToPaste.Columns("D").Insert Shift:=xlToRight
A macro recorder would not be feasible as the macro is periodically executed to add in new rows of data
You say move the values, so you could use Range.Value rather than Cut/Paste
Sub Demo()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim CopyLastRow As Long
Dim DestLastRow As Long
Dim ToCopy As Range
Dim ToPaste As Range
Set wsCopy = Workbooks("OtherWorkBook").Worksheets("OtherWorkSheet")
Set wsDest = Workbooks("ThisWorkBook").Worksheets("ThisWorkSheet")
CopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Row
DestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
' deleted redundant Copy/Paste here
Set ToCopy = wsCopy.Range("A2:V" & CopyLastRow)
Set ToPaste = wsDest.Range("A" & PasteToLastRow)
' copy the data
ToCopy.Copy ToPaste
' Resize ToPaste to the pasted rows, 4 columns
Set ToPaste = ToPaste.Resize(ToCopy.Rows.Count, 4)
' Move first 4 columns 1 column to right, leave formatting intact
ToPaste.Offset(, 1).Value = ToPaste.Value
' Clear the first column
ToPaste.Columns(1).ClearContents
End Sub
Try the following:
Columns("D").Cut
Columns("E").Insert Shift:=xlToRight
Columns("C").Cut
Columns("D").Insert Shift:=xlToRight
Columns("B").Cut
Columns("C").Insert Shift:=xlToRight
Columns("A").Cut
Columns("B").Insert Shift:=xlToRight
Unfortunately, don't have my Microsoft Office computer open to check whether this works, but you should be able to get the gist of my suggested solution from the above.
I am new to VBA coding and trying to create an Excel macro which will create a pivot table based on a dynamic data range. I am using Excel 2016.
The number of columns in the data will remain the same but the number of rows is dynamic.
In my data worksheet, column BZ contains a count of how many records are in the dataset. E.g. If there are 30 records in the dataset, every value in column BZ will be 30. (This data is imported from SAS using DDE which is why I have chosen this method). I have therefore added 1 onto the lastRow variable below to include column names.
My VBA Macro code is currently as follows:
Sub Macro1()
Dim xlsPath As String
Dim xlsFile As String
Dim lastRow As Integer
Dim SrcData As String
Dim StartPvt As String
Dim pvtCache As PivotCache
Dim pvt As PivotTable
xlsxPath = "N:\Analytics\Test\DDE\"
xlsxFile = "Test.xlsx"
lastRow = Sheets(1).Range("BZ2") + 1
SrcData = ActiveSheet.Name & "!" & Range("A1:R" & lastRow & "C77").Address(ReferenceStyle:=xlR1C1)
StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)
Workbooks.Open Filename:=xlsxPath & xlsxFile
Range("A1:BY" & lastRow).Select
Sheets.Add
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData, Version:=6)
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1", DefaultVersion:=6)
Columns("BZ:BZ").Select
Selection.Delete Shift:=xlToLeft
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
This produces an error which says:
Run-time error '1004':
Method 'Range' of 'object'_Global' failed
The debugger points to the line where the SrcData range is determined. I think the issue may be syntax, where I have specified the lastRow within Range.
A solution for this line of code, or any other helpful comments would be greatly appreciated.
You can turn on the Macro Recorder, then click anywhere in your dataset and Excel will automatically select the last used column and last used row in that dataset, just before creating a Pivot Table. Try it and you will see. If you want to use VBA to dynamically select the last row and dynamically select the last column, and check out the code below.
Ways To Find The Last Row
Sub FindingLastRow()
'PURPOSE: Different ways to find the last row number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ActiveSheet
'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
'Ctrl + Shift + End
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
'Using Table Range
LastRow = sht.ListObjects("Table1").Range.Rows.Count
'Using Named Range
LastRow = sht.Range("MyNamedRange").Rows.Count
'Ctrl + Shift + Down (Range should be first cell in data set)
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
End Sub
Ways To Find The Last Column:
Sub FindingLastColumn()
'PURPOSE: Different ways to find the last column number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastColumn As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
'Ctrl + Shift + End
LastColumn = sht.Cells(7, sht.Columns.Count).End(xlToLeft).Column
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastColumn = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
'Using Table Range
LastColumn = sht.ListObjects("Table1").Range.Columns.Count
'Using Named Range
LastColumn = sht.Range("MyNamedRange").Columns.Count
'Ctrl + Shift + Right (Range should be first cell in data set)
LastColumn = sht.Range("A1").CurrentRegion.Columns.Count
End Sub
You can easily incorporate this into the code you already have.