I'm trying to copy data from one workbook to another after a button click but the function range doesn't work and always returns
error 9 "out of range".
Sub Button1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open "C:\Users\Username\Desktop\Allineamento\Data\MasterData.xlsx"
Workbooks("MasterData").Sheets(2).range(Cells(13, 2), Cells(800, 16)).Copy
Workbooks("ImportSheets").Sheets("Master Data").Cells(2, 1).PasteSpecial Paste.Value
Workbooks("MasterData").Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
With basic Excel functions, the Macro-recorder is really useful. This is the code, generated by copying and pasting some excel range:
Sub Macro1()
Range("A1:E8").Select
Selection.Copy
Selection.PasteSpecial xlPasteValues
ActiveSheet.Paste
Application.CutCopyMode = False
Range("L5").Select
Application.WindowState = xlNormal
Range("B7").Select
End Sub
Although, the code is not efficient, it is quite useful to see the needed code for the copy-paste - Range.PasteSpecial xlPasteValues
Thus, in the question code, replace PasteSpecial Paste.Value with PasteSpecial xlPasteValues.
Related
Newbie here! I have an action which I'd like to repeat, for specific workbooks or specific worksheets.
Is there a way to do it without copy and pasting the whole code for the 2nd, 3rd etc worksheets?
Only the workbook and the worksheet names change. other actions (e.g. copy paste) remains the same.
Although there's a "For Each loop", but I don't know how to do it in a way that allows me to specify which worksheets exactly.
For example, I'm
Step 1: copying data from workbook "Red" sheet "Apple". paste into output
workbook.
Repeat action. Step 2: copying data from workbook "Yellow" sheet "Banana". paste into
same output workbook.
Here's my code if anyone could kindly advise. VBA newbie here thank you!
Sub CopyPastefromOtherWB()
Range("B13").Select
'Activate WB1
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Red"
Worksheets("Apple").Activate
Range("A1").Select
Do While Selection.Value <> "Mar"
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Copy
'Activate output notebook
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
Worksheets("Sheet1").Activate
Range("B13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'HERE IS WHERE THE REPEAT HAPPENS. Activate WB2
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\Yellow"
Worksheets("Banana").Activate
Range("A1").Select
Do While Selection.Value <> "Mar"
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Copy
'Activate output notebook
Workbooks.Open Filename:= "C:\Users\Desktop\My macro projects\OutputWB"
Worksheets("Sheet1").Activate
Range("C13").PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
End Sub
Please see How to avoid using Select in Excel VBA.
Sub CopyPastefromOtherWB(ByVal FromPath As String, ByVal FromSheetName As String, ByVal TargetCell As Range)
With Workbooks.Open(FromPath)
With .Worksheets(FromSheetName)
Dim c As Range
Set c = .Rows(1).Find("Mar", LookAt:=xlWhole).Offset(1, 0)
TargetCell.Resize(c.Rows.Count, 1).Value = .Range(c, c.End(xlDown)).Value
End With
.Close False
End With
End Sub
With Workbooks.Open("C:\Users\Desktop\My macro projects\OutputWB").Worksheets("Sheet1")
CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Red", "Apple", .Range("B13")
CopyPastefromOtherWB "C:\Users\Desktop\My macro projects\Yellow", "Banana", .Range("C13")
End With
After months of learning, I developed a solution, feel free to use the code below and tweak it to your needs. This solution is for a set area of cells.
Sub copypaste_adhoc()
Dim inputfile As Workbook
Set inputfile = Workbooks.Open("c:\path\workbook")
Dim arrSht, i
arrSht = Array("worksheet1", "worksheet2")
For i = LBound(arrSht) To UBound(arrSht)
With Worksheets(arrSht(i))
.Range("A31:Z31").Copy
ThisWorkbook.Sheets("Sheet1").Cells(Sheet5.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Next i
Application.CutCopyMode = False
Sheet5.Range("a1").CurrentRegion.EntireColumn.AutoFit
End Sub
I have 2 worksheets (Input & Record), I just want to copy some data from "Input" to "Record", it worked but if I protect "Record".... Paste method of Worksheet class Failed comes up.
So I added script for unprotected sheets and protect sheets, but '1004' stil comes up.
Here the detail of my project.
Input sheet is area for me to input some value to a row. In 1 row at least have 10 values at different column.
Maximum row that I can add is ten rows.
Record sheet is database as Table1 based on how much row from Input sheet that i'll add.
Here my script
Sub adddata() 'this sub code from button on "Input" sheet
Sheets("Input").Select
Range("C15").Offset(1, 0).Select 'select range start from C16
If Range("M27") = 1 Then 'value for how much row that i'll add
Range(Selection, Selection.End(xlToRight)).Select
Else
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy
Sheets("Record").Select
Worksheets("Record").Unprotect Password:="4321"
If Range("B2").Offset(1, 0).Value = "" Then
Range("B2").Offset(1, 0).Select
Else
Range("B2").End(xlDown).Offset(1, 0).Select
End If
ActiveSheet.Paste '<< The trouble maker
Application.CutCopyMode = False
Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
That I want to know:
What I've missed?
The solution of this dilemma.
I think all this Select process is not necessary and you can avoid that. I can edit my answer if you will add your intentions "what you are trying to do".
You want to copy some range from Input and paste it to Record always to the next empty row?
If I understood you correct, maybe something like this?
Sub adddata()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Record").Unprotect Password:="4321"
Dim NextFreeCell As Range
Set NextFreeCell = ThisWorkbook.Worksheets("Record").Cells(Rows.Count, "B").End(xlUp).Offset(RowOffset:=1)
With ThisWorkbook.Worksheets("Input")
If .Range("B2").Value = 1 Then
.Range("C15", .Range("C15").End(xlToRight)).Copy
Else
.Range("C15", .Range("C15").End(xlDown).End(xlToRight)).Copy
End If
End With
NextFreeCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
ErrorHandler:
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
Here is how it works:
This was not included in your original question. So you have to create a new question with additional information to your original question. However this time I will answer here but not next time.
Here is the code for table:
Sub adddata()
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Record").Unprotect Password:="4321"
With ThisWorkbook.Worksheets("Record").ListObjects("Table1").ListRows.Add
With ThisWorkbook.Worksheets("Input")
If .Range("B2").Value = 1 Then
.Range("C15", .Range("C15").End(xlToRight)).Copy
Else
.Range("C15", .Range("C15").End(xlDown).End(xlToRight)).Copy
End If
End With
.Range.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
ErrorHandler:
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Input").Activate
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
Remove all empty cells in table below your last data. This code will add a new line to table. Also table name should correspond to your table name. Can be found in Excel under Format Table
Try this.
Sub adddata()
Worksheets("Record").Unprotect Password:="4321" ' Unlock the target sheet before copying.
Sheets("Input").Select
Range("C15").Offset(1, 0).Select
If Range("M27") = 1 Then
Range(Selection, Selection.End(xlToRight)).Select
Else
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy
Sheets("Record").Select
If Range("B2").Offset(1, 0).Value = "" Then
Range("B2").Offset(1, 0).Select
Else
Range("B2").End(xlDown).Offset(1, 0).Select
End If
Activecell.PasteSpecial xlAll
Application.CutCopyMode = False
Worksheets("Record").Protect Password:="4321", UserInterfaceOnly:=True
End Sub
I need some advice to rectify the code below. I have this code to copy paste lines to another sheet for data compilation purpose. And I'm running well using the with statement below, the problem is, when there's no data to paste, I do not know how to end the code with message box.
I see the similar question above, but how to comply the code into the With statement of VBA below?
Following is the code I read from other user, to return message box if error.
If Err Then
MsgBox "Nothing to paste!"
Err.Clear
End If
My original code, without the Message box return.
*Sub FnLstRow()
Application.ScreenUpdating = False
Dim LR As Long
ThisWorkbook.Worksheets("Data").Select
LR = Cells(Rows.Count, "AO").End(xlUp).Row
Cells(LR, 1).Offset(1, 0).EntireRow.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
With Sheets("LatestData")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub**
this is a suboptimal solution that might not work but you could try: I created a dynamic array and tried to pass your entire selection into it. If the selection had no values, it will select all of the remaining cells in the sheet, and it is likely too large to pass into the array, resulting in a run time error. I didn't touch your code except for creating the array and adding the error handling section. I hope it works lol
Sub FnLstRow()
Application.ScreenUpdating = False
Dim LR As Long
Dim Arr() As Variant
ThisWorkbook.Worksheets("Data").Select
LR = Cells(Rows.Count, "AO").End(xlUp).Row
Cells(LR, 1).Offset(1, 0).EntireRow.Select
Range(Selection, Selection.End(xlDown)).Select
On Error GoTo Handler
Arr = Selection
On Error GoTo 0
Selection.Copy
With Sheets("LatestData")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
Exit Sub
Handler:
MsgBox "Nothing to paste!"
End Sub
I am getting an error
Runtime error 1004: Application defined or Object defined error
in my vba code. Could you please help me correct it?
Sub INPUT_DATA()
' INPUT_DATA Macro
' Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Input").Select
If Range("D55").Value = 0 Then
Range("B2:AI52").Select
Selection.Copy
Sheets("Database").Select
ActiveSheet.Range("A2").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Input").Select
MsgBox ("File has been updated. DO NOT PRESS UPDATE again, as it will enter the same data once again")
End Sub
You didn't say which line is causing the error, but it looks like it's likely this line...
ActiveSheet.Range("A2").End(xlDown).Offset(1, 0).Select
It starts at A2, and then it goes down until it finds the last used row. However, if there aren't any used rows below A2, it finds the very last row in Column A. Then it tries to offset to one row below it, which doesn't exist, and hence the error. Instead, you can find the next available row as follows...
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
Although, there's no need to do all of that selecting. It's very inefficient. So your macro can be re-written as follows...
Option Explicit
Sub INPUT_DATA()
' INPUT_DATA Macro
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Dim sourceWorksheet As Worksheet
Set sourceWorksheet = Worksheets("Input")
Dim destinationWorksheet As Worksheet
Set destinationWorksheet = Worksheets("Database")
With sourceWorksheet
If .Range("D55").Value = 0 Then
.Range("B2:AI52").Copy
With destinationWorksheet
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
End If
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox ("File has been updated. DO NOT PRESS UPDATE again, as it will enter the same data once again")
End Sub
I am trying to run a paste value macro in a different sheet in a workbook that previously had a password protection.
The Macro works fine in the destination sheet for the values but not in the other tabs where i get this error runtime error '1004' - select method of range class failed
How should i proceed to allow this macro to run from a different active sheet?
Sub PasteSpecial_ValuesOnly()
Worksheets("ARF Table").Range("A2:AI13").Copy
'Error occurs below
**Worksheets("ARF Export").Range("A2:AI13").Select**
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("ARF Export").Range("AK2").Value = Worksheets("ARF Export").Range("AD2").Value
End Sub
You only require the top left cell of the destination.
You don't need to .Select and direct value transfer is faster.
Sub PasteSpecial_ValuesOnly()
Worksheets("ARF Table").Range("A2:AI13").Copy
Worksheets("ARF Export").Range("A2").PasteSpecial Paste:=xlValues
Worksheets("ARF Export").Range("AK2").Value = Worksheets("ARF Export").Range("AD2").Value
End Sub
Alternate,
Sub PasteSpecial_ValuesOnly()
with Worksheets("ARF Table").Range("A2:AI13")
Worksheets("ARF Export").Range("A2").resize(.rows.count, .columns.count) = .value
end with
Worksheets("ARF Export").Range("AK2").Value = Worksheets("ARF Export").Range("AD2").Value
End Sub