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
Related
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
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
I found this cool code that identifies the bottom-most row of data in a worksheet (considering all columns), and then types an X in Column B of the following row.
However I have been unsuccessful at creating a loop with this code, so that each worksheet is treated uniquely. My attempts have typed X in the same cell of all worksheets, but not each worksheet individually based on it's own set of data.
Also note that each of my tabs will not always have the same column be the longest, which is why I needed a code to look across all columns to find the bottom-most row.
Can someone suggest how I can loop this and identify the bottom-most row in each worksheet individually?
Sub EndofData()
Dim iRow As Long
Dim iCol As Long
iRow = Cells.Find(What:=”*”, _
After:=Range(“A1”), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Cells(iRow + 1, 2).Select
ActiveCell.FormulaR1C1 = “x”
End Sub
You want to do a For Each Loop:
Sub EndofData()
Dim ws As Worksheet
Dim iRow As range
Dim iCol As Long
For Each ws In ActiveWorkbook.Worksheets
set iRow = ws.Cells.Find(What:=" * ", _
After:=ws.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If not irow is nothing then
ws.Cells(iRow.Row + 1, 2).FormulaR1C1 = "x"
Else
ws.Cells(1, 2).FormulaR1C1 = "x"
End IF
Next ws
End Sub
Thanks to #Darren for help on the error avoidance.
When I am debugging a excel-vba program I came to know my data range is not completely selected.
Below picture shows my data's model and my problem.
I used this code to select the whole range. But this is not working properly.
Dim rngTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
With rngTemp
Please help me by giving the code for selecting the whole range as given in the figure above.
In your code you are searching by xlByRows. And hence you are getting the address of the last cell which has data which is G7.
Further to my comment, Is this what you are trying?
Sub Sample()
Dim lastrow As Long, lastcol As Long
Dim rng As Range
With Sheets("Sheet1") '<~~ Change this to the relevant sheet
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
lastcol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Else
lastrow = 1: lastcol = 1
End If
Set rng = .Range("A1:" & _
Split(.Cells(, lastcol).Address, "$")(1) & _
lastrow)
MsgBox rng.Address
End With
End Sub
PLEASE BE AWARE THAT METHOD BELOW IS NOT RELIABLE IN SOME CASES. I WILL LEAVE THIS ANSWER HERE AS A BAD EXAMPLE. FOR DETAILED INFORMATION PLEASE SEE #SiddharthRout 'S EXPLANATION IN THIS LINK
I would use following code to find used range instead of looking for "*" in the cell value:
Sub SelectRange()
Dim LastRow As Long
Dim LastColumn As Long
Dim aWB As Workbook
Dim aWS As Worksheet
Set aWB = ActiveWorkbook
Set aWS = aWB.ActiveSheet '<-You can change sheet name like aWB.sheets("SheetName")
With aWS.UsedRange
LastRow = .Rows(.Rows.Count).Row
LastColumn = .Columns(.Columns.Count).Column
End With
aWS.Range(Cells(1, 1), Cells(LastRow, LastColumn)).Select '<---Cells(1, 1) is the starting cell of range)
End Sub
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