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)
Related
I want to copy a range of columns from One Excel sheet to Another Excel sheet. So far I have tried and I can able to locate the Cells where I want to actually paste the range of columns from Excel One. Below is the script which I have managed to write so far but could not able to copy and paste the desired content. Required your help here since I am not much good with VB macros. Required your help or direction here.
Sub CopyData()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim CopyLastRow As Long
Dim lastRow As Long
Set ws1 = Workbooks("u_mapping.xlsx").Worksheets("Sheet1")
Set ws2 = Workbooks("mapp_V1.xlsx").Worksheets("mapp")
CopyLastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
lastRow = ws2.Cells(ws2.Rows.Count, "T").End(xlUp).Row
For Each Cell In ws2.Columns(20).Cells
If Len(Cell) = 0 Then ws1.Range("A" & lCopyLastRow).Copy ws2.Range("T2"): Exit For
Next Cell
End Sub
Below is the sample data for your reference.
From
To
Expectation is
As mentioned in the destination Excel sheet Column D is already having few entries which is present source excel column A. So in the case we have to take care it will paste a unique data.
Append Missing Rows
Option Explicit
Sub UpdateV1()
Const SRC_COLUMNS_COUNT As Long = 6
Dim sws As Worksheet: Set sws = Workbooks("u_mapping.xlsx").Sheets("Sheet1")
Dim slrrg As Range
Set slrrg = sws.Cells(sws.Rows.Count, "A").End(xlUp).Resize(, SRC_COLUMNS_COUNT)
Dim dws As Worksheet: Set dws = Workbooks("mapp_V1.xlsx").Sheets("mapp")
Dim dfCell As Range ' Your screenshot suggests column 'D' instead!
Set dfCell = dws.Cells(dws.Rows.Count, "T").End(xlUp).Offset(1)
Dim RowOffset As Long: RowOffset = dfCell.Row - slrrg.Row
If RowOffset > 0 Then Exit Sub
sws.Range(slrrg.Offset(RowOffset), slrrg).Copy dfCell
End Sub
I need to select a Range from after Last Row till end of usedRange.
The below code works, But is there Proper /Shorter code.
Option Explicit
Sub Select_Blank_in_Usedrange()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim LastR As Long, LastR_UsedRange As Long
LastR = ws.Cells(Rows.Count, "A").End(xlUp).Row
LastR_UsedRange = ws.UsedRange.Rows.Count
ws.Range("A" & LastR + 1, "AE" & LastR_UsedRange).Select
End Sub
If the code works and has no redundant parts, I would say it's good. If I were to suggest an improvement, it would be to save the relevant addresses as Range Objects instead of Row numbers. This way you can assemble the larger range directly from the two corners, instead of having to concatenate the address in the final step.
Sub Select_Blank_in_Usedrange()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim TopCorner As Range
Set TopCorner = ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
Dim BottomCorner As Range
With ws.UsedRange.Columns(31)
Set BottomCorner = .Cells(.Cells.Count)
End With
ws.Range(TopCorner, BottomCorner).Select
End Sub
To me, this is much clearer, and the constants are clearly displayed. This will make it easier to edit later, if the number of columns changes, or if the starting column moves from "A".
The shortest code will be the next:
Dim ws As Worksheet: Set ws = ActiveSheet
ws.Range("A" & ws.Range("A" & ws.rows.count).End(xlUp).row + 1, _
"AE" & ws.UsedRange.rows.count + ws.UsedRange.cells(1).row - 1).Select
It will also deal with the case when UsedRange does not start from the first row...
Dim lastrow As Long, lastrow2 As Long
Dim wksSource As Worksheet, wksDest As Worksheet
Dim source1 As Range, target1 As Range, source2 As Range, target2 As Range
Set wksSource = Workbooks("2021 Tracker.xlsm").Worksheets("Sheet3")
Set wksDest = Workbooks("Jan Tracker).xlsm").Worksheets("Sheet1")
lastrow = wksSource.Cells(Rows.Count, 1).End(xlUp).row
lastrow2 = wksDest.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).row
Set source1 = wksSource.Range("A2:A" & lastrow)
Set source2 = wksSource.Range("B2:B" & lastrow)
Set target1 = wksDest.Range("E" & lastrow2)
Set target2 = wksDest.Range("F" & lastrow2)
source1.Copy: target1.PasteSpecial Paste:=xlPasteValues
source2.Copy: target2.PasteSpecial Paste:=xlPasteValues
This code replaces data in columns E and F of destination workbook, but i want it to append to it. Please help.
Your code determines the next row in column A of the destination worksheet: lastrow2 = wksDest.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).Row. But you are pasting to columns E and F. Therefore the last row in column A doesn't change and that results in over-writing.
I have re-written your code to make it more transparent. I think this kind of syntax will make it easier for you to spot errors like the one that you asked about. It may take a little more time to set up but the time is well invested.
Sub AppendData()
Dim wksSource As Worksheet ' Source sheet
Dim wksTarget As Worksheet ' Target sheet
Dim Source1 As Range
Dim Target As Range
Dim Rl As Long ' last row
Set wksSource = Workbooks("2021 Tracker.xlsm").Worksheets("Sheet3")
With wksSource
Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
Set Source = .Range(.Cells(2, "A"), .Cells(Rl, "B"))
End With
Set wksTarget = Workbooks("Jan Tracker).xlsm").Worksheets("Sheet1")
With wksTarget
Set Target = .Cells(.Rows.Count, "E").End(xlUp).Offset(1)
End With
Source.Copy Deestination:=Target
Application.CutCopyMode = False
End Sub
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
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")