I need to modify below's code so that it copies values instead of formulas, but I don't know how to modify this. Can you help me out?
Dim OutApp As Object
Dim OutMail As Object
Dim myDataRng As Range
Dim cell As Range
Dim iCnt As Integer
Dim sMail_ids As String
Dim TempFilePath As String
Dim FileExt As String
Dim TempFileName As String
Dim FileFullPath As String
Dim FileFormat As Variant
Dim Wb1 As Workbook
Dim Wb2 As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Wb1 = ThisWorkbook
Set Wb2 = Workbooks.Add(xlWBATWorksheet)
Wb1.ActiveSheet.Range("A3:K32").Copy Wb2.Sheets(1).Range("A1")
Wb2.Sheets(1).Name = Wb1.ActiveSheet.Name
Please, try the fastest way (using an array and not involve clipboard):
'your code...
'replace Wb1.ActiveSheet.Range("A3:K32").Copy Wb2.Sheets(1).Range("A1") with:
Dim arr
arr = Wb1.ActiveSheet.Range("A3:K32").value
Wb2.Sheets(1).Range("A1").Resize(Ubound(arr), Ubound(arr, 2)).value = arr
'your code
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
Sub NapiMaker()
Dim wb As Workbook
Set wb = ActiveWorkbook
Debug.Print wb.Name
Dim MyFile As String
If MyFile = "" Then
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
wb.Activate
Dim WS_Count As Integer
Dim I As Integer
WS_Count = wb.Worksheets.Count
For I = 1 To WS_Count
wb.Worksheets(I).Range("B7").Copy Workbooks(MyFile).Worksheets(1).Range("A16")
wb.Worksheets(I).Range("B8").Copy Workbooks(MyFile).Worksheets(1).Range("B16")
wb.Worksheets(I).Range("B10").Copy Workbooks(MyFile).Worksheets(1).Range("D16")
wb.Worksheets(I).Range("B11").Copy Workbooks(MyFile).Worksheets(1).Range("J16")
wb.Worksheets(I).Range("B5").Copy Workbooks(MyFile).Worksheets(1).Range("F16")
wb.Worksheets(I).Range("B14").Copy Workbooks(MyFile).Worksheets(1).Range("E16")
Workbooks(MyFile).Worksheets("1").Range("A16").EntireRow.Insert
Next I
End If
End Sub
I want to the the following:
- I open a file.
- Press CRTL+K.
- Lets me choose a file.
- Copy the specified cells to the chosen file.
I can't find the problem.
It's under the For loop
The filename passed as an index to the Workbooks collection appears to not allow the path to be included. (I was sure I had seen somewhere that it could be.) Therefore Workbooks("abcdef.xlsx") would work, but Workbooks("C:\Temp\abcdef.xlsx") will not.
The following code will assign a Workbook object to the opened workbook, and then use that object to refer to it in subsequent statements, therefore avoiding the need to use an index into the Workbooks collection.
Sub NapiMaker()
Dim wb As Workbook
Dim wb1 As Workbook
Set wb = ActiveWorkbook
Debug.Print wb.Name
Dim MyFile As String
If MyFile = "" Then ' myFile will always be blank at this point
MyFile = Application.GetOpenFilename()
Set wb1 = Workbooks.Open(MyFile)
Dim WS_Count As Integer
Dim I As Integer
WS_Count = wb.Worksheets.Count
For I = 1 To WS_Count
wb.Worksheets(I).Range("B7").Copy wb1.Worksheets(1).Range("A16")
wb.Worksheets(I).Range("B8").Copy wb1.Worksheets(1).Range("B16")
wb.Worksheets(I).Range("B10").Copy wb1.Worksheets(1).Range("D16")
wb.Worksheets(I).Range("B11").Copy wb1.Worksheets(1).Range("J16")
wb.Worksheets(I).Range("B5").Copy wb1.Worksheets(1).Range("F16")
wb.Worksheets(I).Range("B14").Copy wb1.Worksheets(1).Range("E16")
'Changed "1" to 1
wb1.Worksheets(1).Range("A16").EntireRow.Insert
Next I
End If
End Sub
I am working on a excel newly jfor 1 weeks where i want to compare opened excel file current open file,
I made all possible but whenever I try to read the row, it only reading the value from the opened , I cant' able to access to read current workbook where i my macro was coded
Sub test1()
Dim iComp
Dim sheet As String
Dim wbTarget As Worksheet
Dim wbThis As Worksheet
Dim bsmWS As Worksheet
Dim c As Integer
Dim x As Integer
Dim strValue As String
Static value As Integer
Dim myPath As String
Dim folderPath As String
k = 3
Filename = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open data") ' Choosing the Trigger Discription
'Set wbTarget = ActiveWorkbook.ActiveSheet
Set theRange = Range("A2:A4")
c = theRange.Rows.Count
strValue = vbNullString
For x = 1 To c
strValue = strValue & theRange.Cells(x, 1).value
Next x
'Set tabWS = Sheets("Tabelle1")
folderPath = Application.ActiveWorkbook.Path
myPath = Application.ActiveWorkbook.FullName
Set bsmWS = Sheets("Tabelle1")
Set wbkA = Workbooks.Open(Filename:="myPath")
Set varSheetA = wbkA.Worksheets("Balance sheet").Range(strRangeToCheck)
Its a 1000 line code , I just put only snippet.
I have myworksheet in the workbook where I am programed . I want to open another worksheet, take the value and compare it with my current worksheet . If string matches (ex range (A1:A2)) then msgbox yes
Have you tried using ThisWorkbook.Sheets("sheet name").Range("A2:A4") or ThisWorkbook.ActiveSheet.Range("A2:A4"). This will ensure the reference is to the workbook where the code is located.
More info on Application.ThisWorkbook
https://msdn.microsoft.com/en-us/library/office/ff193227.aspx.
The Excel hang if the user click the button in the sheet. The button allowed the user to run the following VBA code. If the user runs the code from VBA editor, it's working fine. Kindly help. The code is as the following. I'm trying to copy data from current excel file to the other excel file newly created.
Sub clickBreak()
i = 12
Dim workBookName As String
Dim workBookName2 As String
Dim wb2 As Workbook
Dim wb1 As Workbook
Dim pasteStart As Range
workBookName = Application.ActiveWorkbook.FullName
workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
MsgBox workBookName2
Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wb1 = Workbooks.Open(Filename:=workBookName)
Set pasteStart = [A12:A15]
wb1.Sheets("contents").Range("A12:A15").Copy
Set wb2 = Workbooks.Open(Filename:=workBookName2)
wb2.Sheets("contents").Range("A12:A:15").PasteSpecial xlPasteAll
wb2.Save
End Sub
clickBreak is not an event handler. If the name of your button is Break you must name the sub
BreaK_Click() for it to act as an event handler for the button click event:
Sub BreaK_Click()
...
End Sub
Full Code:
Sub BreaK_Click()
i = 12
Dim workBookName As String
Dim workBookName2 As String
Dim wb2 As Workbook
Dim wb1 As Workbook
Dim pasteStart As Range
workBookName = Application.ActiveWorkbook.FullName
workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
MsgBox workBookName2
Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wb1 = Workbooks.Open(Filename:=workBookName)
Set pasteStart = [A12:A15]
wb1.Sheets("contents").Range("A12:A15").Copy
Set wb2 = Workbooks.Open(Filename:=workBookName2)
wb2.Sheets("contents").Range("A12:A:15").PasteSpecial xlPasteAll
wb2.Save
End Sub
I got the answer
Sub clickBreak()
Dim workBookName As String
Dim workBookName2 As String
Dim wbTarget As Workbook
Dim wbThis As Workbook
Dim strName As String
Set wbThis = ActiveWorkbook
strName = ActiveSheet.Name
workBookName = Application.ActiveWorkbook.FullName
workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wbTarget = Workbooks.Open(workBookName2)
wbTarget.Sheets("contents").Range("A1").Select
wbTarget.Sheets("contents").Range("A12:A15").ClearContents
wbThis.Activate
Application.CutCopyMode = False
wbThis.Sheets("contents").Range("A12:A15").Copy
wbTarget.Sheets("contents").Range("A12:A15").PasteSpecial
Application.CutCopyMode = False
wbTarget.Save
wbTarget.Close
wbThis.Activate
'clear memory
Set wbTarget = Nothing
Set wbThis = Nothing
End Sub
Thanks you for spending time on my question and giving feedback. Sorry for answering my own question, I just want to share my resolution with the other who will be having the same problem.
I got reference from this http://en.kioskea.net/faq/24666-excel-vba-copy-data-to-another-workbook
I'm trying to open a workbook and delete a sheet from it, but it runs the code without errors, and the sheet is still there...
I'm able to modify it, as I changed formulas to values on another sheet.
First of all - Yes, I know the "i" variable is set to do 1 iteration.
Somehow, now when I open the workbook it says it's locked by me - which I don't even know how to do.
So...how can I unlock it? When I go to File-->Info-->Permissions it says 'Anyone can copy, change and modify any part of this workbook.... I can delete the sheet manually as well...
Here's the code:
Sub Change()
Dim wb As Excel.Workbook
Set wb = ThisWorkbook
Dim ws As Excel.Worksheet
Set ws = wb.Sheets("FileSearch Results")
Dim rng As Range
Set rng = ws.UsedRange
Dim cPaths As Integer
cPaths = rng.Column
Dim i As Integer
i = rng.Row
Dim oExcel As Excel.Application
Set oExcel = New Excel.Application
Dim oWB As Workbook
Dim komm As Excel.Worksheet
Dim sh1 As Excel.Worksheet
Do While i < 2
Dim pth As String
pth = ws.Cells(i, cPaths)
Set oWB = oExcel.Workbooks.Open(pth)
Set sh1 = oWB.Worksheets("Sheet1")
With sh1.UsedRange
.Value = .Value
End With
Set komm = oWB.Worksheets("Kommentar")
Application.DisplayAlerts = False
komm.Delete
Application.DisplayAlerts = True
oWB.Close savechanges:=True
i = i + 1
Loop
End Sub
Any ideas?
Sub Change()
Dim wb As Excel.Workbook
Set wb = ActiveWorkbook 'ThisWorkbook
Dim ws As Excel.Worksheet
Set ws = wb.Sheets("FileSearch Results")
Dim rng As Range
Set rng = ws.UsedRange
Dim cPaths As Integer
cPaths = rng.Column
Dim i As Integer
i = rng.row
'Dim oExcel As Excel.Application ***CHANGED***
'Set oExcel = New Excel.Application ***CHANGED***
'Dim oWB As Workbook ***CHANGED***
Dim komm As Excel.Worksheet
Dim sh1 As Excel.Worksheet
Do While i < 2
Dim pth As String
pth = ws.Cells(i, cPaths)
'Set oWB = oExcel.Workbooks.Open(pth) ***CHANGED***
Workbooks.Open (pth) '***ADDED***
Set sh1 = ActiveWorkbook.Worksheets("Sheet1") 'oWB.Worksheets("Sheet1") ***CHANGED***
With sh1.UsedRange
.Value = .Value
End With
Set komm = ActiveWorkbook.Worksheets("Kommentar") 'oWB.Worksheets("Kommentar") ***CHANGED***
Application.DisplayAlerts = False
komm.Delete
Application.DisplayAlerts = True
ActiveWorkbook.Close savechanges:=True 'oWB.Close savechanges:=True ***CHANGED***
i = i + 1
Loop
End Sub
This now opens the workbook and deletes the sheet in the foreground rather than invoking a new instance of Excel and deleting the sheet in the background. This is why the file stays locked, as the new instance which isn't closed by the code, still holds it.
For anyone running into this in the future (like myself), the actual problem is with the mix up in scope when calling Application.DisplayAlerts.
komm is a sheet in oWB, which exists in the new instance of excel oExcel.
Application is a completely different instance and therefor has no effect.
Since the code isn't actually disabling the prompt in the correct instance of excel (oExcel) and it is presumably not visible, the code will just ignore the command and move on.
The simple fix is to use oExcel instead of Application:
Set komm = oWB.Worksheets("Kommentar")
oExcel.DisplayAlerts = False
komm.Delete
oExcel.DisplayAlerts = True