I have a VBA script that allows me to select a file and then copies a range from that file and pasted it into the target worksheet. However every time I do this is opens the source file and then closes which prompts me if I want to save the information on the clip board.
I don't know if it would be better to just copy the data without opening the source excel.
Option Explicit
Sub DCDatabaseCopy()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim DCRowCount As Integer
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied
vFile = Application.GetOpenFilename("Excel Files (*.*)," & "*.*", 1, "Select Excel File", "Open", False)
'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If
'--------------------------------------------------------------
'Copy Range
DCRowCount = wsCopyFrom.Range("A1", wsCopyFrom.Range("A1").End(xlDown)).Rows.Count
wsCopyFrom.Range("A1:G" & DCRowCount).Copy
wsCopyTo.Range("A2").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Close file that was opened
wbCopyFrom.Close SaveChanges:=False
End Sub
Before you close the workbook run:
wbCopyFrom.Application.CutCopyMode = False
This will clear the clipboard.
use these 2 lines of code before and after, it will bypass the clipboard prompt
Application.DiplayAlerts = FALSE
Application.DiplayAlerts = TRUE
Or it could be that you need to use this:
ActiveWindow.Close savechanges:=FALSE
Obviously if the file is not in the ActiveWindow then replace that part of the code with wherver it is
Related
I would like to browse to the specific excel file and copy sheet1 of the file which is opening into the new sheet in my xlsm file. I have written the code like below:
Option Explicit
Sub test_copy_sheet()
Dim path As String
Dim filetoopen As Variant
Dim openwb As Workbook
filetoopen = Application.GetOpenFilename()
If filetoopen <> False Then
Set openwb = Application.Workbooks.Open(filetoopen)
openwb.Sheets(1).Copy
ThisWorkbook.Sheets.Add.Name = "mysheet"
ThisWorkbook.Sheets("mysheet").PasteSpecial xlPasteValues
openwb.Close False
End If
End Sub
When i ran the code, it get the issue as photo
I just want to copy sheet1 of the file opening to sheet name "mysheet". Could you please assist on this ?
As mentioned in the comments, please insert Option Explicit at the top of the module to ensure you declare all variables properly (and also pick up typo like thisworkbook and OpenBook)
Try this code below, it will open the file, copy the first sheet to ThisWorkbook and rename to mysheet:
Sub test_copy_sheet()
Dim filetoopen As Variant
Dim openwb As Workbook
filetoopen = Application.GetOpenFilename()
If filetoopen <> False Then
Set openwb = Application.Workbooks.Open(filetoopen, ReadOnly:=True)
openwb.Sheets(1).Copy ThisWorkbook.Sheets(1)
ThisWorkbook.Sheets(1).Name = "mysheet"
openwb.Close
End If
End Sub
Note: You will need to add additional check to be sure that ThisWorkbook does not have a sheet named mysheet. (i.e. no duplicate names)
I'm trying to create an excel tool where it would extract data from a given filename(workbook). Let's say, on my main workbook in(Sheet1-Cell A1), users will enter the filename. Then on a cmdbutton click, it'll copy the data from that specific filename(workbook).
I have created a file that copies data from another workbook, however, it indicates the specific path & filename of the workbook where the data will be copied.
Dim myData As Workbook
Set myData = Workbooks.Open("C:\Users\Desktop\Book2.xlsx")
Call Sample
Selection.Copy
What I want, is to allow users to just enter the filename, then excel will locate that file, select data from there & copy it on the main workbook(Sheet2).
I figured something out
Sub copydata()
Dim path As String
path = InputBox("Please input path")
Application.ScreenUpdating = False
Dim actualfile As Workbook
Set actualfile = ActiveWorkbook
Dim script As Object
Set script = CreateObject("Scripting.FileSystemObject")
Dim catalogue As Object
Set catalogue = script.GetFolder(path)
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim textfile As Object
For Each textfile In catalogue.Files
Workbooks.Open textfile
Dim loadedfile As Workbook
Set loadedfile = ActiveWorkbook
loadedfile.Worksheets(1).Range("A2").CurrentRegion.Offset(1, 0).Copy
actualfile.Worksheets(1).Range("A2").Offset(1, 0).End(xlUp).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
loadedfile.Close Savechanges:=False
Next textfile
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub
The only problem though is, it copies data to the column after the heading instead of copying it to the row below the heading - help on this is very much appreciated! :)
In Excel, I altered some code to automatically copy text of a pre-selected range into a .txt file when the Command Button is clicked. For some reason, whenever this code attempts to copy from cells that have an =IF(AND( __, __ ), __, __) statement in it, it will not take the text, however it works perfectly fine for text that is simply entered into the cell with no form of equation. Also, the first few cells in the column are plain text without any equations, so having the equation in the code itself will not be desirable. What can I do to my code so it will not alter the information copied from Excel cells containing an equation referencing other cells? Code is exactly as seen below. Also, I am working in Excel 2007. Thank you!
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim saveFile As String
Dim WorkRng As Range
On Error Resume Next
Set WorkRng = ActiveSheet.Range("A1:B25").Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Application.Workbooks.Add
wb.Worksheets(1).Paste
saveFile = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
wb.SaveAs Filename:=saveFile, FileFormat:=xlText, CreateBackup:=False
wb.Close
End Sub
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim saveFile As String
Dim WorkRng As Range
Set WorkRng = ActiveSheet.Range("A1:B25") '<<no .Copy
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Application.Workbooks.Add
'WorkRng.Copy wb.Worksheets(1).Range("A1")
'copy values only
WorkRng.Copy
wb.Worksheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
saveFile = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
wb.SaveAs Filename:=saveFile, FileFormat:=xlText, CreateBackup:=False
wb.Close
End Sub
I'm not sure how to tackle this issue. I've done quite a bit of research, but most of the answers I find are a little different than what I need.
What I'm trying to accomplish is this:
Open up an existing workbook manually (wbAI),
Start macro,
Use msoFileDialogOpen to find and open a file (call this wb2),
Store part of wb2's file name (there is a date in the file name) as a variable or string. (I'm not sure which is better for this purpose. Maybe I don't need to store it all...),
Paste part of wb2's filename (the date) in a certain cell in wb1,
Copy the necessary data from wb2,
Paste the data in wb1,
Format the data,
Use a VLOOKUP on the pasted data,
Close wb2 without saving
End the macro.
My macro can do every step listed above except for numbers four and five. On one hand, I'm wondering how I need to pursue this, and on the other hand, I'm wondering where this would fit inside my current code.
To give you an example of what I'm talking about: let's say that in step three I open up a workbook that's named "01.31.13 Group Names." And the file path is from a Sharepoint site so it looks like this:
"https://company.com/team/teamone/_layouts/xlviewer.aspx?01.31.13%20Group%20Names%20.xlsm&Source=https......."
How can I pick out only the date in the filename/filepath?
Here's the beginning of my code:
Sub Test()
Dim lastRow As Long, i As Long
Dim ws As Worksheet
Dim wbSource As Workbook
Dim wbAI As Workbook
Dim vrtSelectedItem As Variant
Set wbAI = ActiveWorkbook
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = https://company.com/team/teamone & "\"
.AllowMultiSelect = False
.Show
' ****** Is this where the new code could be inserted? *******
For Each vrtSelectedItem In .SelectedItems
Set wbSource = Workbooks.Open(vrtSelectedItem)
Next
End With
' Check if the first cell contains data. If not then close file
If Range("Profile!H9") = "" Then
ActiveWorkbook.Close savechanges:=False
ActiveWorkbook.Saved = False
Any suggestions are welcome! Thank you for your time!
Edit: This is how my code looks after Philip's suggestion:
Sub Test()
Dim lastRow As Long, i As Long
Dim ws As Worksheet
Dim wbSource As Workbook
Dim wbAI As Workbook
Dim vrtSelectedItem As Variant
Set wbAI = ActiveWorkbook
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = https://company.com/team/teamone & "\"
.AllowMultiSelect = False
.Show
For Each vrtSelectedItem In .SelectedItems
Set wbSource = Workbooks.Open(vrtSelectedItem)
Next
End With
dateVar = Left(wbSource.Name, 8) '<~~~~ New code
' Check if the first cell contains data. If not then close file
If Range("Profile!H9") = "" Then
ActiveWorkbook.Close savechanges:=False
ActiveWorkbook.Saved = False
Else
Sheets("Profile").Activate
Range("H9:I" & Cells(Rows.Count, "H").End(xlUp).Row).Select
Selection.Copy
Windows("wbName").Activate
Sheets("Sheet1").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1").Value = dateVar '<~~~ New code
from the filename you would use the LEFT FUNCTION to return the LEFT 8 chars of the date:
dateVar=left(wbSource.name, 8)
then you can put that in your cell:
rangeVar.value=dateVar
hope that gets you going
Philip
My work is regarding formating 100 of files everyday. though i have a macro desined for the purpose but i have to run the macro on each and every file one after saving previous.
my question is how can i be able to run my macro on these opened workbooks in one step. As i save one it would run on other one in the queue.
Put the following macro in a "BASE" workbook as Passerby mentioned
Sub SO()
Dim macroList As Object
Dim workbookName As String
Dim wbFullPath
Dim macroName As String
Dim currentWb As Workbook
Dim masterWb As Workbook ' the Excel file you are calling this procedure from
Dim useWbList As Boolean
Dim height As Long, i As Long
Dim dataArray As Variant
useWbList = False ' DEFINE which input method
Set macroList = CreateObject("Scripting.Dictionary")
If useWbList Then
' you can also from the dictionary from 2 columns of an excel file , probably better for management
With masterWb.Worksheets("Sheet1") '<~~ change Sheet1 to the sheet name storing the data
height = .Cells(.Rows.Count, 1).End(xlUp).Row ' Assume data in column A,B, starting from row 1
If height > 1 Then
ReDim dataArray(1 To height, 1 To 2)
dataArray = .Range(.Cells(1, 1), .Cells(height, 2)).Value
For i = 1 To height
macroList.Add dataArray(i, 1), dataArray(i, 2)
Next i
Else
'height = 1 case
macroList.Add .Cells(1, 1).Value, .Cells(1, 2).Value
End If
End With
Else
' ENTER THE FULl PATH in 1st agrument below, Macro Name in 2nd argument
' Remember to make sure the macro is PUBLIC, try to put them in Module inside of Sheets'
macroList.Add "C:\Users\wangCL\Desktop\Book1.xlsm", "ThisWorkbook.testing"
'macroList.Add "FULL PATH", "MACRO NAME"
'macroList.Add "FULL PATH", "MACRO NAME"
'macroList.Add "FULL PATH", "MACRO NAME"
End If
Application.DisplayAlerts = False
For Each wbFullPath In macroList.keys
On Error GoTo 0
macroName = macroList.Item(workbookName)
workbookName = Mid(wbFullPath, InStrRev(wbFullPath, "\") + 1)
Err.Clear
On Error Resume Next
Set currentWb = Nothing
Set currentWb = Workbooks(workbookName) ' see if the workbook is already open
If Err.Number <> 0 Then
' open the workbook if workbook NOT opened
Set currentWb = Workbooks.Open(workbookName, ReadOnly:=True)
End If
On Error GoTo 0
' run the macro
Application.Run workbookName & "!" & macroList.Item(wbFullPath)
'close the workbook after running the macro
currentWb.Close saveChanges:=False
Set currentWb = Nothing
Next wbFullPath
End Sub
Hope it helps and please let me know if there's anything unclear
I have got my solve using below code.
Sub OpenAllWorkbooksnew()
Set destWB = ActiveWorkbook
Dim DestCell As Range
Dim cwb As Workbook
For Each cwb In Workbooks
**Call donemovementReport**
ActiveWorkbook.Close True
ActiveWorkbook.Close False
Next cwb
End Sub