I am trying to copy a dynamic range from a table and copy it to another workbook but am having issues copying the dynamic matrix that is created.
I've tried multiple lines of code but with similar results. I've stepped through the code one line at a time, and the lastRow and lastColumn functions return the expected values. The issue arises when I try to select the matrix and copy it. I feel like there's a simple fix and I'm missing something.
Workbooks.Open Filename:=OOBmap
'Copies AM open order book and pastes it into master spreadsheet
Set startCell = ActiveSheet.Range("A1")
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Range(Cells(1, lastRow), Cells(1, lastColumn)).Select
Selection.Copy
If you want the whole range from A1 to bottom right use this
ActiveSheet.Range(Cells(1, 1), Cells(lastrow, lastColumn)).Copy
If you just want the last column use
ActiveSheet.Range(Cells(1, lastColumn), Cells(lastrow, lastColumn)).Copy
Cells syntax is row then column, you were mixing them up.
Plus you don't need to Select before copying.
Obviously, copying alone won't do anything, you then need to paste somewhere.
You needed the destination range to paste:
Option Explicit
Sub CopyPaste()
Dim wsSource As Worksheet, wbDestination As Workbook, wsDestination As Worksheet, LastRow As Long, lastColumn As Long
Set wbDestination = Workbooks.Open(Filename:=OOBmap, ReadOnly:=True)
Set wsSource = ThisWorkbook.Sheets("Name") 'change Name for the name of the worksheet you are copying from
Set wsDestination = wbDestination.Sheets("Name") 'change Name for the name of the worksheet you are copying to
'Copies AM open order book and pastes it into master spreadsheet
With wsSource
LastRow = .Cells(.Count, 1).End(xlUp).Row
lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(Cells(1, LastRow), Cells(1, lastColumn)).Copy wsDestination.Range("A1") 'here the range were u want to paste
End With
End Sub
Related
I am trying to copy range A6:L, down to the last row from Sheet "Step 1".
Then paste onto Sheet "Vendor_Copy", but pasting on the first empty row after A19.
Here is what I have, which does everything but paste in the correct place. It's pasting starting in A1, which is a blank cell. However, even if I fill all rows from 1 - 19 with the number 1, it still pastes in A1 on sheet "Vendor_Copy".
Thank you for your help!
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim lr As Long
Set sht1 = Worksheets("Step 1")
Set sht2 = Worksheets("Vendor_Copy")
lr = sht2.Range("A19").End(xlDown).Row
sht1.Activate
Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
sht2.Activate
Cells(lastrow + 1, 1).PasteSpecial
Don't use the Selection object. It's meant as an interface between screen and VBA. Instead, use the Range object which lets you address the worksheet directly.
The row on Sheet2 that you wish to address is the next free one but not smaller than 19. In Excel terms that is the result of the MAX() function, incorporated in the code below.
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim Rng As Range
Dim Cl As Long ' Column: last used
Dim Rt As Long ' Row: target
Set Sht1 = Worksheets("Step 1")
Set Sht2 = Worksheets("Vendor_Copy")
With Sht1
Cl = .Cells(6, .Columns.Count).End(xlToLeft).Column
Set Rng = .Range(.Cells(6, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Resize(, Cl)
End With
With Sht2
' Columns(1) = Columns("A")
Rt = WorksheetFunction.Max(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 19)
Rng.Copy Destination:=.Cells(Rt, 1)
End With
Note that Cells(6, 1).End(xlDown).Row - or Range("A6").End(xlDown).Row will give you the address of the last used cell below A6 that is followed by a blank. Cells(Rows.Count, 1).End(xlUp).Row will give you the first used cell in column A looking from the sheet's bottom (Rows.Count). The difference is that looking from top down the next blank might not be the last used cell in the column. It's the same difference between Cells(6, 1).End(xlToRight).Column and Cells(6, Columns.Count).End(xlToLeft).Column. Looking from left to right you find the last used column. Looking from right to left you find the first blank.
Try this:
Dim sht1 As Worksheet
Dim sht2 As Worksheet
dim rng As Range
Set sht1 = Worksheets("Step 1")
Set sht2 = Worksheets("Vendor_Copy")
with sht1
Set rng = .Range("A6", .Range("A6").End(xlDown))
Set rng = .Range(rng, rng.End(xlToRight))
end with
rng.copy
sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1,0).PasteSpecial
See also: How to avoid using Select in Excel VBA
I have written a code in which I try to copy and paste several ranges of data from one worksheet to the other, but I want to copy the data below the previous set of data. The code I used for the copy entries is this part:
Selection.Copy
Windows(Workbook1).Activate
Sheets(Sheet1).Select
Cells(Rows.Count, 1).End(x1Up).Select
ActiveCell.PasteSpecial xlPasteValues
I get the error on the 4th row
(Application Defined or object Defined error).
Your code can be condensed using the example from https://learn.microsoft.com/en-us/office/vba/api/excel.range.copy:
Worksheets("Sheet1").Range("A1:D4").Copy destination:=Worksheets("Sheet2").Range("E5")
Applied to your work:
Dim lRow As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim Sourcews As Worksheet: Set Sourcews = wb.Worksheets("Sheet21")
Dim Destinationws As Worksheet: Set Destinationws = wb.Worksheets("Sheet1")
lRow = Destinationws.Cells(Destinationws.Rows.Count, "A").End(xlUp).Row + 1
Sourcews.Range("A1:D4").Copy Destination:=Destinationws.Range("A" & lRow)
Avoid using activate and select. It is slow and can be unreliable.
Try this code, please. It will copy the selected range values in the last empty row of column A:A. I deduced that from your way of trying to calculate. But, you did that in an incorrect way. You would copy your range over the "A1:A" & last cell range. Is that what you really want?
Sub testCopyValues()
Dim sh As Worksheet, lastRow As Long, rng As Range
Set rng = Selection
Set sh = Workbooks("Workbook1").Sheets(1)
lastRow = sh.Cells(Rows.count, 1).End(xlUp).row
sh.Range("A" & lastRow + 1).Resize(rng.Rows.count, rng.Columns.count).Value = rng.Value
End Sub
If you need to paste on another sheet of the same workbook, please replace
Set sh = Workbooks("Workbook1").Sheets(1) with Set sh = ActiveWorkbook.Sheets(1)
I have made a macro that copies two dynamic table columns from one worksheet to another. On the Second worksheet I want to subtract those two columns and paste the result on a separate column/vector. All of this needs to be dynamic since I plan on running the macro once a day.
The closest I have come is the following code:
Sub Makro2()
Dim ws_3 As Worksheet
Set ws_3 = ThisWorkbook.Worksheets(2)
Application.CutCopyMode = False
ws_3.Range("E3:E400").FormulaR1C1 = "=RC[-2]-RC[-1]"
End Sub
So all I need in reality is for E3:E400 to be dynamic since the range of the other two columns change every day.
PS. Rather new at VBA.
This is just basic, ensure you declare your variable.
Dim lRow As Long
lRow = Range("D" & Rows.Count).End(xlUp).Row
Range("E3:E" & lRow).FormulaR1C1 =
You could try:
Option Explicit
Sub test()
Dim wsSource As Worksheet, wsDestination As Worksheet
Dim LastRow1 As Long, LastRow2 As Long, rng1 As Range, rng2 As Range, LastColumn As Long
With ThisWorkbook
Set wsSource = .Worksheets("Sheet1") '<- Data appears here
Set wsDestination = .Worksheets("Sheet2") '<- Data will be copy here
End With
With wsSource
'Let's say the two columns we want to copy is column A & B. Find Last row of A & B
LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
'Create the ranges you want to copy
Set rng1 = .Range("A1:A" & LastRow1)
Set rng2 = .Range("B1:B" & LastRow2)
End With
With wsDestination
'Paste column after the last column of row 1. Find last column row 1
LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
rng1.Copy
.Cells(1, LastColumn + 1).PasteSpecial xlPasteValues
rng2.Copy
.Cells(1, LastColumn + 2).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End Sub
I'm still new to VBA and I'm a bit lost on how to solve this particular issue.
I have several worksheets within 1 workbook. The goal is to copy data from each worksheet based on the column headings, since not all of the column headings are uniform across all sheets.
For ex:
The Master Sheet has 6 column headings which I'd like to pull.
Sheet 1 has 8 column headings, the values for some columns within this are blank.
Sheet 2 has 7 column headings.
Sheet 3 has 10 column headings, etc.
My goal is to go to each sheet, have it loop through each column heading and copy/paste the data into the Master sheet if the column heading matches.
I don't know how to get it to look for the last row and copy the whole column based on the heading.
An example of code I've pieced together below:
Sub MasterCombine()
Worksheets("Master").Activate
Dim ws As Worksheet
Set TH = Range("A1:F1")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "Master" And ws.Range("A8").Value <> "" Then
ws.Select
Range("A8").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("Master").Activate
For Each cell In TH
If cell.Value = "Subject" Then
cell.EntireColumn.Copy
End If
The problem with the above is that it copies the entire range but doesn't filter out column headings that aren't in the Master sheet.
Any help would be appreciated.
This might work. Loading your Master headers into an array. Then looping through each ws - then looping through your headers array.
Option Explicit
Sub MasterMine()
Dim Master As Worksheet: Set Master = ThisWorkbook.Sheets("Master")
Dim LR1 As Long, LR2 As Long, LC1 As Long, LC2 As Long
Dim ws As Worksheet, Found As Range, i As Long, Arr
LC1 = Master.Cells(1, Master.Columns.Count).End(xlToLeft).Column
Arr = Master.Range(Master.Cells(1, 1), Master.Cells(1, LC1)).Value
For Each ws In Worksheets
For i = LBound(Arr) To UBound(Arr)
LC2 = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Set Found = ws.Range(ws.Cells(1, 1), ws.Cells(1, LC2)).Find(Arr(i, 1), LookIn:=xlWhole)
If Not Found Is Nothing Then
LR1 = Master.Cells(Master.Rows.Count, i).End(xlUp).Offset(1).Row
LR2 = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
ws.Range(ws.Cells(2, Found.Column), ws.Cells(LR2, Found.Column)).Copy
Master.Cells(LR1, i).PasteSpecial xlPasteValues
End If
Next i
Next ws
End Sub
Not strong in VBA but have set this macro up to copy from a sheet (stoping at blank value) and pasting into another sheet after the last set of values, working well.
Issue is I am needing to change the copying range to this ws.Range("AF3:AQ" & LastRow).Copy
When doing so it only copies the first 3 rows then stops. I can fix the range to AF3:AQ59 but it then includes blanks which is not ideal. Any help would be greatly appreciated.
Regards
Sub DBMeters()
Dim ws As Worksheet, ws1 As Worksheet
Dim LastRow, LRow As Long
Set ws = Sheets("DB_Sort")
Set ws1 = Sheets("DB Input")
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
LRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
ws.Range("A3:L" & LastRow).Copy
ws1.Range("A" & LRow + 1).PasteSpecial xlPasteValues
End Sub