Sub test1()
Dim LR As Long
LR = WorksheetFunction.Max(20, Range("C" & Rows.Count).End(xlUp).Row + 1)
Range("C3").Resize(, 3).Cut Destination:=Range("C" & LR)
End Sub
The above source code works to copy(cut) paste into same sheet.
Now i need cut and paste into another sheet
ie: Sheet1(Cut) to sheet2(Past)
Thanks
Below code will cut data from sheet1 to sheet2
Sub test1()
Dim LR As Long
LR = WorksheetFunction.Max(20, Range("C" & Rows.Count).End(xlUp).Row + 1)
Sheets("Sheet1").Range("C3").Resize(, 3).Cut
Sheets("Sheet2").Range("C" & LR).PasteSpecial xlPasteValues
End Sub
Related
I am attempting to copy Columns D & E from the last row to the next row. Currently I am getting a Compile Error: Type Mismatch. I've been fighting this all day with different ways of going about it. Any help would be appreciated.
Sub PTB()
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
End With
Dim lastCellCoords As String: lastCellCoords = "D" & LastRow & ":E" & LastRow
Dim firstEmptyRow As Integer: firstEmptyRow = LastRow + 1
Dim firstEmptyCoords As String: firstEmptyCoords = "D" & firstEmptyRow & ":E" & firstEmptyRow
If Not LastRow Is Nothing Then
' Now Copy the range:
Worksheets("Survey").Range(lastCellCoords).Copy
' And paste to first empty row
Worksheets("Survey").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Else
MsgBox ("There is no data in specified range")
End If
End Sub
I wrote this code and it keeps giving me an error that the size of the copy area and the paste area are not the same.
but if I just use the copy-paste method, it works perfectly. could you pls help me out.
Sub copy()
eRow = Sheet5.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Sheet4.Range("a4", "d23").copy
Sheet5.Cells(eRow, 1).PasteSpecial (xlPasteValues)
End Sub
Move values one by one with a value transfer. As implied in the name, a value transfer does not carry over formats.
This just copies the 2 individual cells A4 & D23
Sub copy_me()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row
ws.Range("A" & lr).Value = ws.Range("A4").Value
ws.Range("D" & lr).Value = ws.Range("D23").Value
End Sub
If you meant to grab the entire range A4:D23 then
ws.Range("A4:D23").Copy
ws.Range("A" & lr).PasteSpecial xlPasteValues
OR
ws.Range("A" & lr).Resize(20, 4).Value = ws.Range("A4:D23").Value
I am trying to copy 3 entire rows below a cell which includes a text.
I've already wrote this but there are some issues that I can't solve due to being a beginner of VBA.
Option Explicit
Private Sub SearchandInsertRows()
Dim lRow As Long, iRow As Long
With Worksheets("Main_Page")
lRow = .Cells(.Rows.Count, "A").End(xlup).Row
For iRow = lRow to 1 Step -1
If .Cells(iRow, "A").Value = Range("D5") Then
.Rows(iRow).Resize(3).Insert
End if
Next iRow
End With
End Sub
I want excel to read the entire A column and find the cell which has same text with cell D5 (Text is BillNumber). Then add 3 blank rows above that. Lastly copy the three cells below BillNumber and paste it to recently created 3 blank rows.
Here is screenshot to make it more understandable.
Here is one way, remove the MsgBox lines, they are for debugging.
Sub insertPaste()
Dim D5Val As String, wk As Workbook, fVal As Range
Set wk = ThisWorkbook
With wk.Sheets("Sheet1")
'Value from D5
D5Val = .Range("D5").Value
'Find D5 on column A
Set fVal = .Columns("A:A").Find(D5Val, , xlValues, , xlNext)
If fVal Is Nothing Then
'Not found
MsgBox "Not Found"
Else
'Found
MsgBox "Found at: " & fVal.Address
'Insert 3 Cells on top of the cell found with the data from the 3 cells below
.Range("A" & (fVal.Row + 1) & ":A" & (fVal.Row + 3)).Copy
.Range("A" & fVal.Row & ":A" & (fVal.Row + 2)).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
End With
End Sub
Copy Cells Below Text Above Text
The Code
Private Sub SearchandInsertRows()
Dim lRow As Long, iRow As Long
With Worksheets("Main_Page")
lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For iRow = lRow To 1 Step -1
If .Cells(iRow, "A").Value = .Range("D6") Then
.Rows(iRow).Resize(3).Insert
.Rows(iRow + 3 & ":" & iRow + 5).Copy .Rows(iRow)
End If
Next iRow
End With
End Sub
I'm copying an array (Sheet1!A2:A831) and want to paste it on Sheet2! in every 26th row starting at A1.
I was working with this macro, but I'm having some trouble:
Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("Sheet1!A2:A831").Copy
For i = 26 To LR Step 26
Range("A" & i).PasteSpecial Paste:=xlPasteFormulas
Next i
End Sub
Is this what you are trying?
Sub test()
Dim LR As Long, i As Long, n As Long
With Sheets("Sheet1")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
n = 1
For i = 2 To LR 'A2:A831
.Range("A" & i).Copy
Sheets("Sheet2").Range("A" & n).PasteSpecial _
Paste:=xlPasteFormulas
n = n + 25
Next i
End With
End Sub
I have a workbook containing multiple sheets of varying sizes. I want to add a total column after the last row and copy the formula across all columns. I have defined the last row and column and the formula appears as expected in the correct place but I receive an error when trying to fill across. How do I correctly reference both dynamic cells for the fill? I'm just using a single sheet for now for testing but will eventually be looping through all the sheets in the book.
Sub Addtotals()
Dim Bord As Worksheet
Dim LRow As Long
Dim LCol As Long
Dim frmcell As Range
Set Bord = Sheets("Borders")
With Bord
'--> Define last rows and columns
LRow = .Range("A" & Rows.Count).End(xlUp).Row
LCol = .Range("A" & Columns.Count).End(xlToLeft).Column
'--> Add Total text to first column
.Range("A" & LRow).Offset(1, 0).Select
ActiveCell = "Total"
'--> Add formula to next column
Set frmcell = Range("B" & LRow + 1)
frmcell.Formula = "=sum(B2:B" & LRow & ")"
'--> Fill formula across range
frmcell.Select
Selection.AutoFill Destination:=Range(frmcell & LCol), Type:=xlFillDefault
End With
End Sub
Thanks :)
Like this?
Option Explicit
Sub Addtotals()
Dim Bord As Worksheet
Dim LRow As Long, LCol As Long
Set Bord = Sheets("Borders")
With Bord
'--> Define last rows and columns
LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
'--> Add Total text to first column
.Range("A" & LRow).Value = "Total"
'--> Fill formula across range
.Range("B" & LRow & ":" & _
Split(Cells(, LCol).Address, "$")(1) & LRow).Formula = _
"=Sum(B2:B" & LRow - 1 & ")"
End With
End Sub