I'm trying to copy a range of cells from one data file (sh1 as Worksheet) to another (sho as Worksheet). The cells should be pasted beneath the existing data. Since the amount of cells to copy and the amount of existing data varies. I created this code:
Dim sh1 As Worksheet, sho As Worksheet, lr As Long, rng1 As Range
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A3:B" & lr)
rng1.Copy sho.Cells(Rows.Count, 1).End(xlUp)(2)
This works perfectly fine - but it copies the functions in the Worksheet sh1 to the Worksheet sho and not the values. I know that the code for this is ".PasteSpecial" but I'm not able to match it in my code, without destroying the other prerequisites.
If you have Sheet1 and Sheet2 please try the below:
Option Explicit
Sub test()
Dim sh1 As Worksheet, sho As Worksheet, lr As Long, rng1 As Range
Set sh1 = Sheet1
Set sho = Sheet2
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A3:B" & lr)
rng1.Copy
sho.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
End Sub
Instead of:
rng1.Copy sho.Cells(Rows.Count, 1).End(xlUp)(2)
Assign the values directly. It avoids the clipbaord and thus it is quicker:
sho.Cells(sho.Rows.Count, 1).End(xlUp).Offset(2).Resize(rng1.rows,rng1.columns).Value = rng1.Value
You can use this code to copy the value of A1 to B1 (if A1 is a formula)
Range("B1").Formula = Range("A1")
Related
I have a large range of cells that I am trying to select easily because it is too large to manually select and copy every time. I am looking for a way to quickly locate the entire range of data and select it. Not to be confused with only selecting every non-empty cell. There are cells within the big range that could be empty, but I also want to include them.
Example is my photo. I want to discover and select all the data that is A1:E7, including the cells in the middle that may be empty. If possible, I would want to de-select the heading as well and only select A2:E7.
So far I have managed to select everything with:
Range("A1").CurrentRegion.Select
But I am unsure how to de-select the top row after that.
Try this
Sub selectWithoutHeaders()
With Range("A1").CurrentRegion
.Offset(1, 0).Resize(.Rows.Count - 1).Select
End With
End Sub
You can use the handy UsedRange to determine the filled area on the sheet without checking each row and column for their last cell coordinates.
With UsedRange, you create a range stretching from A2 to the last cell, and then select it.
Sub Example()
Dim WS As Worksheet
Set WS = ActiveSheet
Dim LastCell As Range
With WS.UsedRange
Set LastCell = .Cells(.Rows.Count, .Columns.Count)
End With
WS.Range("A2", LastCell).Select
End Sub
Here is the Range(Cells(2, 1), Cells(LastRow, LastColumn)).Select version.
Public Function GetLastRowOfSheet(ws As Worksheet) As Long
Dim usedRng As Range
Dim lastRow As Range
Set usedRng = ws.UsedRange
Set lastRow = usedRng.Rows(usedRng.Rows.Count).EntireRow
GetLastRowOfSheet = lastRow.row
End Function
Public Function GetLastColOfSheet(ws As Worksheet) As Long
Dim usedRng As Range
Dim lastRow As Range
Set usedRng = ws.UsedRange
Set lastCol = usedRng.Columns(usedRng.Columns.Count).EntireColumn
GetLastColOfSheet = lastCol.Column
End Function
Sub SelectAllCells()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim lastRow As Long: lastRow = GetLastRowOfSheet(ws)
Dim lastCol As Long: lastCol = GetLastColOfSheet(ws)
Range(Cells(2, 1), Cells(lastRow, lastCol)).Select
End Sub
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 data on Sheet1 which varies in quantity. And I need a macro to loop through all the range if if the cell has a value, then copy it to a specific column on Sheet2. I cannot simply copy the whole range for reasons I won't get into. I need to loop through each cell one by one and paste the value in a specific format on Sheet2.
I have the below code, which gives me
Error '1004' Method 'Range of Object'_Worksheet' failed.
Sub COPY()
Dim i As Long, j As Long, rng As Range, k As Long, ws1 As Worksheet, ws2 As Worksheet
k = 1
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = Range("B4:D17")
For i = 1 To rng.Rows.Count
If Not IsEmpty(rng.Cells(i, 1)) Then
ws1.Range(rng.Cells(i, 3)).Copy Worksheets("Sheet2").Range("A1")
End If
Next
End Sub
Forget the rng object altogether. It would be more necessary in a For Each statement, but you are simply looping through rows in your sheet.
Create a simple For i statement that just loops the rows you need:
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim i As Long
For i = 4 To 17
If Not IsEmpty(ws1.Cells(i, 2)) Then
ws1.Cells(i, 4).Copy ws2.Range("A1")
End If
Next i
As I've already pointed out, your copy destination ws2.Range("A1") is static, so everytime your criteria is met it continues to overwrite your data here. But you seem to have that handled so I won't assume what you are trying to do with it.
I have some code in which I am trying to sort the data set in a csv file based on the content of a cell in another (the main) workbook. Then based on this sort, copy a range of visible cells between the first and sixth columns, but with a dynamic last row thus the range will be dynamic. This dynamic range is then pasted into the main sheet, which will then allow me to do further work on this dataset.
Can't seem to get the sort to work or the dynamic range working. I've tried all sorts of variation on the code below and am looking for some inspiration.
Sub Get_OA_Data()
'Find OA data from source SQL file and copy into serial number generator
Dim ws As Worksheet
Dim wkb2 As Workbook
Dim ws2 As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
'This section sets the workbooks and worksheets to be used for this macro
Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")
Set rng2 = ws.Range("F6")
' This line deletes any content of the cannot assign serial number added previously
ws.Range("I6:I7").ClearContents
'This hides all rows which do not match the desired OA number (found in rng2)
For Each Cell In ws2.Range("A1").End(xlDown)
If Left(Cell.Value, 6) <> rng2.Value Then
Cell.EntireRow.Hidden = True
End If
Next Cell
Set StartCell = ws2.Range("A1")
LastRow = StartCell.SpecialCells(xlCellTypeVisible).Row
LastColumn = StartCell.SpecialCells(xlCellTypeVisible).Column
'This section selects and copies the visible range from csv file into serialisation generator
Set rng = ws2.Range(StartCell.ws2.Cells(LastRow, LastColumn))
rng.Copy
ws.Activate
ws.Range("D12").Select
Selection.PasteSpecial 'Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Any help would be greatly appreciated, I've bought a couple of books, but none of the stuff in my books is helping with this issue.
P.S I have used very similar code with specific set ranges and it works fine, but this one has me stumped. There may also be an issue with the dataset- which is why I have the LEFT formula in the code (but this seems to work OK).
Try...
Option Explicit
Sub Get_OA_Data()
Dim wkb2 As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range, xCell As Range
Dim LR As Long, LC As Long, LR2 As Long
Set ws = ThisWorkbook.Worksheets("Data Entry")
Set wkb2 = Workbooks.Open("\\srvabdotfpr08\PC_APPS\forum\Gateshead Serialisation\sys_serialisation1.csv")
Set ws2 = wkb2.Worksheets("sys_serialisation1")
ws.Range("I6:I7").ClearContents
LR2 = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row
For Each xCell In ws2.Range("A1:A" & LR2)
xCell.EntireRow.Hidden = Left(xCell.Value, 6) <> ws.Range("F6")
Next xCell
LR = ws2.Range("A" & ws.Rows.Count).End(xlUp).Row
LC = ws2.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Set rng = ws2.Range(ws2.Cells(1, 1), ws2.Cells(LR, LC))
rng.SpecialCells(xlCellTypeVisible).Copy
ws2.Range("D12").PasteSpecial xlPasteValues
End Sub