I have an audit that is done daily. I have been asked to save the audit points to a separate sheet for review by the mgmt. team. The code is below but when I run it I get an error: Script out of range.
Sub copy1()
Dim sheet2 As Worksheet
Dim sheet10 As Worksheet
Set sheet2 = Worksheets("sheet2")
Set sheet10 = Worksheets("sheet10")
sheet2.Range("a2:g10").Copy
sheet10.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).pastspecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
It's difficult to say for sure, but it is likely that you are receiving the "Subscript out of range" error because your workbook does not have the worksheets named "Sheet2" and "Sheet10".
The following code copies data from Sheet2 and pastes the values of the data to the next available row on Sheet10.
Sub Copy2()
Dim DestinationStartingCell As Range
Dim SheetRowCount As Long
Worksheets("Sheet2").Range("A2:I29").Copy
SheetRowCount = Worksheets("Sheet10").Rows.Count '1048576 for Excel 2007 and later
Set DestinationStartingCell = Worksheets("Sheet10") _
.Range("A" & SheetRowCount).End(xlUp).Offset(1, 0)
DestinationStartingCell.PasteSpecial xlPasteValues
End Sub
You could use this code
emptyrow=WorksheetFunction.CountA(Workbooks(<workbookname>).Sheets(10).Range("A:A"))+1
Workbooks(<workbookname>).Sheets(10).Cells(emptyrow,1).pastespecial xlPasteValues
to dynamically find the first empty row in Sheet10 to paste to.
Related
I have code which nicely copies data from multiple sheets in a workbook to a summary sheet and the variable number of sheets have always contained data in exactly the same format.
The input files now have a variable number of columns (roughly 50% exactly the same and 50% variable) and I now need to extend the code so that the sheet name is added to the data copied to the summary sheet. I can then copy the fixed-format data onto the summary sheet and use part of that, along with the sheet name, to reference the variable data and copy it into the necessary column.
The current code is below and I would be grateful if someone could assist with adding a column and the sheet name. Copying the variable data in once I have the sheet name will be straightforward.
Sub CopyData()
Application.ScreenUpdating = False
Dim wsSummary As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long
Set wsSummary = Worksheets("Summary")
LastRow = wsSummary.Cells(Rows.Count, "A").End(xlUp).Row
wsSummary.Range("A2:R" & LastRow).Clear
ShtCount = ActiveWorkbook.Sheets.Count
For i = 2 To ShtCount
Worksheets(i).Activate
LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Row
Range("A2:R" & LastRow2).Select
Selection.Copy
Sheets("Summary").Activate
LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Next i
End Sub
Thanks
I've refactored the code a little to make it a bit better - Here's how it works:
Sub CopyData()
Application.ScreenUpdating = False
Dim wsSummary As Worksheet
Dim LastRowWs As Long
Dim LastRowSummary As Long
Dim StartRowSummary As Long
Set wsSummary = ThisWorkbook.Worksheets("Summary")
LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1
wsSummary.Range("A2:R" & LastRowSummary).Clear
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
LastRowWs = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
StartRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1 'first empty row
ws.Range("A2:R" & LastRowWs).Copy Destination:=wsSummary.Range("A" & StartRowSummary)
LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row
wsSummary.Range("S" & StartRowSummary & ":S" & LastRowSummary) = ws.Name
End If
Next
Application.ScreenUpdating = True
End Sub
As you can see it's fairly similar initially, but I have stripped out all the .Select, .Activate etc commands as they're not needed and can slow down a script during execution. I've also fully qualified all worksheet references to make sure we always know what part of the workbook we're referring to.
LastRowSummary is set initially to the last row plus 1. This is simply to ensure that if you only have headers in the summary sheet, you won't delete those.
The For Each loop allows us to iterate for every worksheet ws in the workbook.
We don't want to extract data from "Summary" so don't carry out the commands for that sheet.
Find the last row in the A column from whatever worksheet we're on, and detect where on the Summary sheet it's going to start from (important when we're going to be setting the worksheet name later on).
Copy the range from one worksheet to the other. Now get the updated last row for the Summary sheet as this tells us how many rows we need to tag for the worksheet name we copied from.
Since we have a handy reference to the worksheet in ws, we can just set column S to the ws.Name, using the start and end rows we detected earlier to ensure the name is set on all the rows (I've used column S because you only seemed to be copying A to R; S is just the next column; adjust as required for where you want the worksheet name to go).
And finally, remember to switch the Application.ScreenUpdating back on. Though since this version doesn't use the .Select or .Activate, you won't be flicking between sheets and so you could just drop both the False and True setting of this property without any negative result.
Let me know if you need any further explanation?
I'm trying to create a macro in which it takes a dynamic number of rows (user inputted) and pastes them into a table in a different sheet. I was having a difficult time searching and finding ways for doing this at first. I have a workaround below that works the first time (it correctly takes the 'raw' range and pastes it into the table) when I run it from VBA but crashes when I press the macro-assigned button right after. My code is below:
Sub AddRawData()
Dim count_of_data As Long
Dim rng As Range
Set rng = Sheets("New Input Raw Data").Range("B5", Range("B5").End(xlDown).End(xlToRight))
count_of_data = rng.Rows.Count
Sheets("Master Data").Select
For x = 1 To count_of_data
ActiveSheet.ListObjects(1).ListRows.Add
Next x
Sheets("New Input Raw Data").Select
rng.Select
rng.Cut
Sheets("Master Data").Select
Range("b65536").End(xlUp).End(xlUp).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
End Sub
I'm stuck at the moment and have tried various work arounds like using ActiveCell.paste or Range.Paste, but run into the same crashing issue. Any suggestions or code corrections would be greatly appreciated. Thank you!
If you want to copy the new inserted data from New Input Raw Data worksheet to the end of existing data in Master Data sheet, you don't need all the Select and most of the lines, you can just run the code below:
Sub AddRawData()
Dim rng As Range
Dim sht_NewData As Worksheet
Dim sht_MasterData As Worksheet
Set sht_NewData = ThisWorkbook.Worksheets("New Input Raw Data")
Set sht_MasterData = ThisWorkbook.Worksheets("Master Data")
sht_NewData.Select
Set rng = sht_NewData.Range("B5", Range("B5").End(xlDown).End(xlToRight))
rng.Copy Destination:=sht_MasterData.Range("B" & sht_MasterData.Cells(sht_MasterData.Rows.Count, "B").End(xlUp).Row + 1)
End Sub
Hi I have code which is meant to
Loop through all worksheets which begin with "673"
Copy all the rows which have data from row 5 onwards
Paste the entries on the next empty row in the "Colours" worksheet
I'm having the following issues:
Code only runs in the worksheet that is active
Doesn't loop through all worksheets
When it pastes in the "Colours" worksheet, it pastes directly over the headings in row 2. The first blank row is row 3 onwards and I would like the logic to paste at the next available blank row as it loops through the sheets.
Sub Consolidate()
Dim lastrow As Long
Dim report As Worksheet
Set report = Excel.ActiveSheet
For Each Sheet In ActiveWorkbook.Worksheets
If InStr(Sheet.Name, "673") > 0 Then
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End
(xlUp)).EntireRow.Copy
End With
Worksheets("Colours").Select
lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row
Worksheets("Colours").Cells(lastrow + 1, 1).Select
ActiveSheet.Paste
End If
Next
End Sub
Your help would be greatly appreciated.
KS is right, to get your code functioning you just need to reference the sheet. I'd started modifying it further so I'll post what I've done in totality:
Firstly I removed the 'Set report = ' line, that's not needed (alternatively you could have 'Set report' at the beginning of the loop, but it's easier to work directly 'With Sheet' as KS says).
CHANGED1 = You said it should loop through worksheets that 'begin' with 673, so this new line checks for the first three characters matching 673, rather than just looking to see if 673 appears anywhere in the sheet name.
NEW = Activates the sheet, this makes the next copy command work.
CHANGED2 = With Sheet as explained above.
CHANGED3 = You said it should copy the rows that have data from row 5 onwards (previously your code would copy rows 1-5).
Sub Consolidate()
Dim lastrow As Long
Dim report As Worksheet
For Each Sheet In ActiveWorkbook.Worksheets
If Left(Sheet.Name, 3) = "673" Then 'CHANGED1
Worksheets(Sheet.Name).Select 'NEW
With Sheet 'CHANGED2
.Range("A5", Range("A" & 65536).End(xlUp)).EntireRow.Copy 'CHANGED3
End With
Worksheets("Colours").Select
lastrow = Worksheets("Colours").Cells(Worksheets("Colours").Rows.Count, 1).End(xlUp).Row
Worksheets("Colours").Cells(lastrow + 1, 1).Select
ActiveSheet.Paste
End If
Next
End Sub
Hope this helps!
try the following code
Sub Consolidate()
Dim sheet As Worksheet, coloursSheet As Worksheet
Set coloursSheet = ActiveWorkbook.Worksheets("Colours")
For Each sheet In ActiveWorkbook.Worksheets
If Left(sheet.Name, 3) = "673" Then
sheet.Range("K5:K" & sheet.Cells(sheet.Rows.Count, "K").End(xlUp).Row).SpecialCells(xlCellTypeConstants).EntireRow.Copy _
Destination:=coloursSheet.Cells(coloursSheet.Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
it:
avoids useless selections and variables
copies non blank cells only (assuming data are "constants", i.e. not formulas)
I am new using macro of Excel, and this is the first time I ask a question here.
I did some research here about this problem, but still can't solve it.
I have several sheets named :page 1, page 2, etc, and I want to copy the data in specific range and paste them to the sheets named "ULD".
When I run the macro in page 1, everything works perfect. But when I run it in page 2 or other sheet, the new data will paste and replace the data pasted from page 1.
The following is my vba code:
Sub test()
Dim ws As Worksheet
Set ws = Sheets("ULD")
'Only Copy Visible Cells'
Range("L3:L100").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("ULD").Activate
For Each cell In ws.Range("I4:I10").Cells
If IsEmpty(cell) = True Then cell.Select.Paste: Exit For
Next cell
End Sub
Besides, I want the data being paste only value, how should I write the code?
There is some confusion, this is how I interpret what you are trying to do.
Sub test2()
Dim ws As Worksheet, LstRw As Long
Set ws = Sheets("ULD")
With ws
LstRw = .Cells(.Rows.Count, "I").End(xlUp).Row
End With
'Only Copy Visible Cells'
Range("L3:L100").SpecialCells(xlCellTypeVisible).Copy
ws.Range("I" & LstRw + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = 0
End Sub
This is the code which I used to copy data from multiple sheets to single sheet.
I want to know if there is any way by which I can copy the data into "Report" sheet starting from 3rd Column, i.e, the data should be pasted into sheet from 3rd column onwards.
Sub AppendDataAfterLastColumn()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Variant
Dim CopyRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Delete the summary worksheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Report").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' Add a worksheet with the name "Report"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Report"
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
lastcol = DestSh.Cells(1, DestSh.Columns.Count).End(xlToLeft).Column
' Find the last column with data on the summary
' worksheet.
Last = lastcol
lastCol3 = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
' Fill in the columns that you want to copy.
Set CopyRng = sh.Range(sh.Cells(1, 2), sh.Cells(15, lastCol3))
' Test to see whether there enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Columns.Count > DestSh.Columns.Count Then
MsgBox "There are not enough columns in " & _
"the summary worksheet."
GoTo ExitTheSub
End If
' This statement copies values, formats, and the column width.
CopyRng.Copy
With DestSh.Cells(1, Last + 1)
.PasteSpecial 8 ' Column width
.PasteSpecial xlPasteValues
'.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Data sheet 1 from comments:
Data sheet 2 from comments:
Expected output from comments:
This sort of copy can be done easily with Copy. In order to pick the output Range for the paste part, you can use an Application.InputBox with a Type:=8 parameter. This prompts Excel to open the Range selection dialog which works well.
Once you know those two pieces, the only difficulty is building the Ranges. This is not difficult, but is specific to the context, existing data on the sheets, and degree of robustness. For the example below, I am using CurrentRegion to get the block of data (same as hitting CTRL+A) and then Intersect to only get the desired columns. You can also make use of UsedRange and End to build ranges.
Picture of ranges shows the different sheets for input and the final sheet for output. The sheet to paste into c is empty for now.
Code does the work to get the two ranges to copy and then prompts for an output location. From there, it pastes the resulting Ranges into the desired location. There is an Offset to ensure that the 2nd range does not overlap the first.
Sub CopyFromTwoRanges()
Dim rng_set1 As Range
Dim rng_set2 As Range
Dim rng_output As Range
'build the ranges
Set rng_set1 = Intersect(Sheets("a").Range("C:F"), _
Sheets("a").Range("C1").CurrentRegion)
Set rng_set2 = Intersect(Sheets("b").Range("C:F"), _
Sheets("b").Range("C1").CurrentRegion)
'prompt for cell
Set rng_output = Application.InputBox("Pick the range", Type:=8)
'ensure a single cell only
Set rng_output = rng_output.Cells(1, 1)
'paste the ranges
rng_set1.Copy rng_output
rng_set2.Copy rng_output.Offset(, rng_set1.Columns.Count)
End Sub
Result shows the prompt with cell selected and then the output.