Excel vba paste on last row of data - vba

i need some code modifications here, on paste command on vba, but the thing is it will paste on the last row of data
im using this code, and this work perfectly but when im try to copy another data it replace the current one
Range(Range("A2:L2" & lastrow), ActiveCell.End(xlDown)).PasteSpecial

change line as
Range(Range("A2:L2" & lastrow), ActiveCell.End(xlDown)).offset(1,0).PasteSpecial

Try using .Insert
Sub Macro2()
Rows("6:6").Copy
Rows("15:15").Insert Shift:=xlDown
End Sub

First of all, your one line of code isn't very much help and the copy line should be there too...
Then :
Range(Range("A2:L2" & lastrow), ActiveCell.End(xlDown)).PasteSpecial
There is no need to select a range of cells if you copied a range to paste, just the first cell where you want to paste!
So the most important part is the copy!
Your code should look something like this :
With ThisWorkBook.Sheets("SheetToCopy")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
.Range("A2:L" & LastRow).Copy
End With
With ThisWorkBook.Sheets("SheetToPaste")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
.Range("A" & LastRow + 1).PasteSpecial
End With

Related

Selecting last-1 row and auto filling to last +1 row

I want to select the row before the last row, auto fill down to the row below the last row. For some reason the Destination Rows does not like the format of the named range. Here is my code which receives an error:
Sub Range_Find_Method()
Dim lRow As Long
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Rows(lRow - 1).Select
Selection.AutoFill Destination:=Rows(lRow - 1 : lRow + 1), Type:=xlFillDefault
End Sub
This is the correct syntax:
Selection.AutoFill Destination:=Rows(lRow - 1 & ":" & lRow + 1), Type:=xlFillDefault
As a next step, try avoiding Select and Selection - How to avoid using Select in Excel VBA, if you feel like it.

Excel VBA file increasing

I have a shared excel file (xlsm) where about 10 users enter into the cells a2 - x2 and then click a button(macro) which copies the data to the last row down.
The macro works but the file size keeps increasing by a lot and I don't know why. Sorry but my vba is very beginner so I have looked up some code online.
Sub Submit()
Application.CommandBars("Reviewing").Controls("&Update File").Execute
'this should save the file and then copy the data and paste to last row
ActiveWorkbook.Save
With ThisWorkbook.Sheets("Sheet1")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Cells.Find(What:="*", _
After:=.Range("a5"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
.Cells(2, 25) = Environ("USERNAME")
.Range("A2:Y" & LastRow).Copy
End With
'sheet to paste too
With ThisWorkbook.Sheets("Sheet1")
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
LastRow = 1
End If
.Range("A" & LastRow + 1).PasteSpecial xlPasteValues
End With
With Worksheets("Sheet1")
.Range("B2:F2").ClearContents
.Range("H2:Q2").ClearContents
.Range("S2:Y2").ClearContents
End With
ActiveWorkbook.Save
End Sub

copy sheet content to another sheet

I want to copy the content of one sheet at the end of the other, i have tried this vba code and it works,
Private Sub CommandButton1_Click()
Sheets("B").Select
Range("A1:H14").Select
Range("A1:H14").Copy
Sheets("A").Select
' Find the last row of data
Range("B48:I48").Select
ActiveSheet.Paste
Sheets("A").Select
End Sub
but what i want is to copy without having to specify the range of the data, because i have many files and many data and it's gonna be hard to do all of that manually and change the range a each time.
Below will copy entire content in Sheet B to Sheet A
Sheets("B").Cells.Copy Destination:=Sheets("A").Range("A1")
You do not need to select cells while copying.
There's no need to use so many Select, which slows down the code, you can use the 1 line below will copy the entire contents of Sheet("B") to the first empty row at Column "A" in Sheet("A").
Dim Rng As Range
Dim lRow As Long
Dim lCol As Long
Dim lPasteRow As Long
With Sheets("B")
lRow = .Cells.Find(What:="*", _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lCol = .Cells.Find(What:="*", _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
lPasteRow = Sheets("A").Cells.Find(What:="*", _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
.Range(.Cells(1, 1), .Cells(lRow, lCol)).Copy Destination:=Sheets("A").Range("A" & lPasteRow + 1)
End With
I usually do something like this, assuming sheet1 is the sheet to be updated by data from sheet2;
dim destLen as Long 'rows used in sheet 1
dim sourceLen as Long 'rows used in sheet 2
Open directory with source files and loop through each file and do the following
destLen = Sheet1.Range("A"&Rows.Count).End(xlUp).Row
sourceLen = Sheet2.Range("A"&Rows.Count).End(xlUp).Row
Sheet2.Range("B1" & ":I" & sourceLen).copy
Sheet1.Range("A" & destLen + 1).pasteSpecial xlValues
Application.CutCopyMode = False

Replace worksheet name within the function in VBA in case of loop

I am creating several worksheets based on some worksheet format just simply copying all its content with formulas. Only I give a new name to the sheet.
I want that each time I create a sheet and giving it a name, format! word in all cells must be replaced with active worksheet name.
I tried to write some codes but it seems not working.
Sub createsheet()
LastRow = Sheets("SUMMARY").Range("A" & Rows.Count).End(xlUp).Row
Dim ws As Worksheet
For i = 9 To LastRow
Set ws = ThisWorkbook.Sheets.Add(after:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Left(Sheets("SUMMARY").Cells(i, 1), 31)
wsrepl = Worksheets(Worksheets.Count).Name
Sheets("format").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Worksheets(Worksheets.Count).Activate
ActiveSheet.Paste
ActiveSheet.Cells(2, 2) = Sheets("SUMMARY").Cells(i, 1)
ActiveSheet.Cells(5, 2) = Sheets("SUMMARY").Cells(i, 1)
Worksheets(Worksheets.Count).Activate
Cells.Replace What:="format!", Replacement:= _
wsrepl, LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next i
End Sub
Any help will be highly appreciated.
Cells.Replace What:="format!", Replacement:= _
"'" & wsrepl & "'" & "!", LookAt:=xlPart, SearchOrder:=xlByRows _
, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
I found an answer.

Deleting all rows in Excel after one containing searched for text

I have a spreadsheet with a varying number of rows in it. At the bottom of the useful information on the spreadsheet is a row called "Terminations", followed by a varying number of rows none of which I'm interested in.
How can I write a VBA script to search for "Terminations" and delete ALL rows after it?
I can search for "Terminations" like so:
Cells.Find(What:="Terminations", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
And I can delete rows like so:
Rows("245:246").Select
Selection.Delete Shift:=xlUp
However, my attempts thus far to combine these two has been fruitless.
Try this one:
Sub test()
Dim rng As Range
Dim lastRow As Long
'change Sheet1 to suit
With ThisWorkbook.Sheets("Sheet1")
'find Terminations
Set rng = .Cells.Find(What:="Terminations", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
'if Terminations NOT found - exit from sub
If rng Is Nothing Then Exit Sub
'find last row
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastRow = 1
End If
'I use lastRow + 1 to prevent deletion "Terminations" when it is on lastrow
.Range(rng.Row + 1 & ":" & lastRow + 1).Delete Shift:=xlUp
End With
End Sub
How to determine lastRow from here