What is wrong with this code?:
Private Sub Copy_Images()
Dim wks, wks2 As Worksheet
Set wks = Sheets("export")
Set wks2 = Sheets("HomePage")
wks2.Activate
wks2.Shapes("picture").Copy
wks.Activate
wks.Paste Range("A1")
End Sub
Error: Method 'Paste' of object '_Worksheet' failed - 1004
Try this:
Private Sub Copy_Images()
Dim wks as worksheet, wks2 As Worksheet
Set wks = Sheets("export")
Set wks2 = Sheets("HomePage")
wks2.Shapes("picture").Copy
wks.range("A1").Paste
End Sub
Try below code
Private Sub Copy_Images()
Dim wks As Worksheet
Dim wks2 As Worksheet
Set wks = Sheets("export")
Set wks2 = Sheets("HomePage")
wks2.Activate
wks2.Shapes("picture").Copy
wks.Activate
Range("A1").Select
ActiveSheet.Paste
End Sub
Related
I am starting out with VBA and have encountered issues with the following code. Ultimately I just want to store the row for use later. Can someone assist me please?
Sub UpdateQuote()
Dim wb As Workbook
Dim ws As Worksheet
Dim FoundCell As Range
Dim FoundRow As Range
Dim FindValue As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
FindValue = Sheet24.Range("D3")
Set FoundCell = Sheet20.Range("A:A").Find(What:=FindValue)
Set FoundRow = FoundCell.Row
Application.ScreenUpdating = False
MsgBox FoundRow
End Sub
Can someone please point out what's wrong with this snippet of code? Every time a value is changed in the specified range (A1:B6), Excel simply quits with Microsoft Error Reporting dialogue. I am not allowed to uncheck 'Error Checking (Turn on background error checking)' in Excel Preferences.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1:B6")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call Macro1
MsgBox "Test"
End If
End Sub
Macro1:
Sub Macro1()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim rInterestCell As Range
Dim rDest As Range
Set wb = ActiveWorkbook
Set wsData = wb.Sheets("Sheet1")
Set wsDest = wb.Sheets("Formula Results")
For Each rInterestCell In Range("Interest_Range").Cells
wsData.Range("A7").Value = rInterestCell.Value
wsData.Calculate
Set rDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
If rDest.Row < 6 Then Set rDest = wsDest.Range("A6")
rDest.Value = wsData.Range("A6").Value
Next rInterestCell
End Sub
Second Macro
Sub Macro2()
Dim FLrange As Range
Set FLrange = Range(“Initial_Rate”)
For Each cell In FLrange
cell.Offset(0, 5).Formula = "=SUM(B3/100*A7)”
Next cell
End Sub
You'd better turn off events with Application.EnableEvents = False before doing so much calculation in Macro1.
If this works, just comment MsgBox "Before Macro1" and MsgBox "After Macro1"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Me.Range("A1:B6")
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
MsgBox "Before Macro1"
Macro1
MsgBox "After Macro1"
End If
End Sub
Macro1:
Sub Macro1()
Dim wB As Workbook
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim rInterestCell As Range
Dim rDest As Range
Set wB = ActiveWorkbook
Set wsData = wB.Sheets("Sheet1")
Set wsDest = wB.Sheets("Formula Results")
Application.EnableEvents = False
For Each rInterestCell In Range("Interest_Range").Cells
wsData.Range("A7").Value = rInterestCell.Value
wsData.Calculate
DoEvents
Set rDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
If rDest.Row < 6 Then Set rDest = wsDest.Range("A6")
rDest.Value = wsData.Range("A6").Value
Next rInterestCell
Application.EnableEvents = True
End Sub
I'm trying to assign the code name of a worksheet to a vriable.
Some times it gets the code name correctly, and sometimes it doesn't, the variable stays null.
Dim sCodeName As String
sCodeName = Worksheets(atar).CodeName
atar is a variable that contains the worksheet name.
When i stop the code running, and coninue in debug mode, it works fine.
What can be the reason?
Worksheets without qualification refers to same as ActiveWorkbook, perhaps you're assuming too much about which workbook is active in some instances.
It is recommended to fully qualify Worksheets. So get a reference to a Workbook object , say wbFoo and then use sCodeName = wbFoo.Worksheets(atar).CodeName
You could try something like the code below to verify that atar does exist in one of the worksheet names in ThisWorkbook.
Option Explicit
Sub GetWorksheetCodeName()
Dim sCodeName As String
Dim atar As String
Dim Sht As Worksheet
'atar = "Sheet3" '<-- for tests only
' loop through all worksheets in ThisWorkbook
For Each Sht In ThisWorkbook.Worksheets
If Sht.Name Like atar Then
sCodeName = Worksheets(atar).CodeName
Exit For
End If
Next Sht
End Sub
CREATE MULTIPLE WORKSHEET BUT SOMETIMES NOT WORK WITH MACRO FROM WORKSHEET ONLY WORK WITH VBA CODE RUN
Sub WSCreate()
Dim WSA As String
Dim WSB As String
Dim WS As Worksheet
WSA = "SheetA"
WSB = "SheetB"
Application.DisplayAlerts = False
On Error Resume Next
'DELETE MULTIPLE WORKSHEETS (IF Already Exist)
Set WS = Nothing
Set WS = Sheets(WSA)
WS.Delete
Set WS = Nothing
Set WS = Sheets(WSB)
WS.Delete
Set WS = Nothing
'CREATE MULTIPLE WORKSHEETS
With Application.ThisWorkbook
.Worksheets.Add.Name = WSA 'WSA = SheetA
.VBProject.VBComponents(Worksheets(WSA).CodeName).Name = WSA
.Worksheets.Add.Name = WSB 'WSB = SheetB
.VBProject.VBComponents(Worksheets(WSB).CodeName).Name = WSB
End With
If Err <> 0 Then Exit Sub
End Sub
Hello I'm trying to copy columns C, R, W,X from file 1 to file 2 with below code but keep getting an error. My VBA knowledge isn't that good yet but probably has to do with the range setting? I've tried multiple ways but can't get it to work.
Am I using the right setting or should I use another action to get the specific columns?
Sub PFS()
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open("path to copy")
Set wsCopy = wbCopy.Worksheets("Blad1")
Set rngCopy = wsCopy.Range("d, e").EntireColumn
Set wsPaste = wbPaste.Worksheets("PFS")
Set rngPaste = wsPaste.Range("a1")
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Application.DisplayAlerts = False
wbCopy.Save
wbCopy.Close
End Sub
Solutions to copy entire column.
Sub copy()
Dim wb As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Sheets("old")
Set wbNew = Workbooks("Book.xlsx")
Set wsNew = wbNew.Sheets("new")
ws.Columns(3).copy
wsNew.Columns(3).Insert Shift:=xlToRight
ws.Columns(18).copy
wsNew.Columns(18).Insert Shift:=xlToRight
ws.Columns(23).copy
wsNew.Columns(23).Insert Shift:=xlToRight
ws.Columns(24).copy
wsNew.Columns(24).Insert Shift:=xlToRight
Set wsNew = Nothing
Set wbNew = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub
The worksheet name may change. Because of that I want to set the worksheet object based on the worksheet's codename. How can I do this?
My best attempt so far is:
Sub UpdateNameDropdown()
Dim wksName As String
wksName = ThisWorkbook.Sheets(Sheet16).Name
Dim wks As Worksheet
Set wks = Sheets(wksName)
End Sub
But I get a type mismatch error on the row wksName = ThisWorkbook.Sheets.Sheet16.Name
This?
Sub Sample()
Dim wks As Worksheet
Set wks = Sheet16
With wks
Debug.Print .Name
'~~> Do what you want
End With
End Sub
This uses the codename as a String
Sub CodeIt()
Dim CodeName As String
CodeName = "Sheet1"
Dim WS As Worksheet, GetWorksheetFromCodeName As Worksheet
For Each WS In ThisWorkbook.Worksheets
If StrComp(WS.CodeName, CodeName, vbTextCompare) = 0 Then
Set GetWorksheetFromCodeName = WS
Exit For
End If
Next WS
MsgBox GetWorksheetFromCodeName.Name
End Sub
Thank you Gary's Student. I midified your function to the following:
Function GetWorksheetFromCodename(codeName As String) As Worksheet
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If StrComp(wks.codeName, codeName, vbTextCompare) = 0 Then
Set GetWorksheetFromCodename = wks
Exit For
End If
Next wks
End Function