I'm working on a project in which I would like to have: browsing through files and selecting which to work with, copying and opening those workbooks from destination where their copies were created, then creating a new workbook(excel file) and copying information to it, which every workbook opened earlier would be in a separate sheet.
I have already done browsing through the files but I find it hard to go next.
That's the sample code I have by far.
Public Sub CommandButton1_Click()
Dim i As Integer
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "All Files", "*.*"
If .Show = True Then
For i = 1 To fd.SelectedItems.Count
ListBox1.AddItem fd.SelectedItems(i)
Next
End If
End With
End Sub
It's just a matter of iterating through the workbooks.
Dim v as variant
If .Show = True Then
For Each v In fd.SelectedItems
'check if this is a valid workbook
Set WB = Workbooks.Open(v)
'Your code here
WB.Close savechanges:=False
Next v
End If
Related
I am at my wits end and have come to you for your help.
What I am trying to accomplish is to rename a single worksheet (the only worksheet), in multiple workbooks, in a chosen directory to the workbook file name in Excel.
I have found code that will work within a single workbook, however I do not know how to get it to work on multiple workbooks in a directory chosen by the user or ran from a batch/vbs file in the same directory.
Here is the code I was using on a single workbook:
Sub RenameSheet()
Dim wbname
wbname = Replace(ActiveWorkbook.Name, ".xlsx", "")
ActiveSheet.Select
ActiveSheet.Name = wbname
Range("A1").Select
End Sub
I want to be able to do this for all files in a folder chosen by the user or files in the same directory as a batch file/vbs executable file if there is a way to execute this from running either a batch or vbs file?
If there are questions or I have missing something, please let me know and I will answer to the best of my ability.
Any help will be greatly appreciated.
Open File Dialog (Pick which books to modify)
Change sheet name to wbName (your code here)
Close File (Save)
Repeat 2 - 3 for all selected books
This will need modification if there is more than 1 sheet on any of the workbooks selected. IF there is only one sheet, ActiveSheet will suffice.
Sub RenameSheet()
Dim CurrentBook As Workbook
Dim ImportFiles As FileDialog
Dim FileCount As Long 'Count of workbooks selected
Dim wbName As String
'Open File Picker
Set ImportFiles = Application.FileDialog(msoFileDialogOpen)
With ImportFiles
.AllowMultiSelect = True
.Title = "Pick Files to Adjust"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Cycle through books
For FileCount = 1 To ImportFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
wbName = Replace(CurrentBook.Name, ".xlsx", "")
CurrentBook.Activate
ActiveSheet.Name = wbName
CurrentBook.Close True
Next FileCount
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I had to tweak a couple of lines but this works beautifully. Thank you urdearboy.
Sub RenameSheet()
Dim CurrentBook As Workbook
Dim ImportFiles As FileDialog
Dim FileCount As Long 'Count of workbooks selected
Dim wbName As String
'Open File Picker
Set ImportFiles = Application.FileDialog(msoFileDialogOpen)
With ImportFiles
.AllowMultiSelect = True
.Title = "Pick Files to Adjust"
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Show
End With
Application.DisplayAlerts = False
Application.DisplayAlerts = False
'Cycle through books
For FileCount = 1 To ImportFiles.SelectedItems.Count
Set CurrentBook = Workbooks.Open(ImportFiles.SelectedItems(FileCount))
wbName = Replace(CurrentBook.Name, ".xlsx", "") ' had to rework this line to the original
CurrentBook.Activate
ActiveSheet.Name = wbName
CurrentBook.Close True
Next FileCount ' had to change this to FileCount to remove the error "invalid next control variable"
Application.DisplayAlerts = True
Application.DisplayAlerts = True
End Sub
Is there a way to make it where user selects which sheet to copy from, after they opened file?
I'd like to do this because there may be multiple sheets with same format, but have different names.
Example:
Original workbook named VSC (Contains sheets Compare, Plot)
Secondary workbook named SF (Contains sheets Results1, Results2, Results3)
User clicks button on VSC, and file dialog opens, and user selects SF in a certain directory, then asks user to select which sheet to choose from - user chooses Results2 sheet, copies the data (Range"B2:B5"), then pastes it back to Compare sheet.
Would this be possible? I am not sure how to start.
Current code that asks user to select SF workbook:
Sub GetFilePath()
Dim objFSO as New FileSystemObject
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Here is one approach. You type in the sheet name. Adjust copy and paste ranges to suit.
Sub GetFilePath()
Dim objFSO As New FileSystemObject, w As String, wb As Workbook
Application.ScreenUpdating = False
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Set wb = Workbooks.Open(.SelectedItems(1))
End With
w = InputBox("Enter sheet name")
If SheetExists(w) Then
wb.Sheets(w).Range("B2:B5").Copy
ThisWorkbook.Sheets("Compare").Range("A1").pastespecial xlvalues
Else
MsgBox "Sheet not found"
End If
wb.Close False
Application.ScreenUpdating = True
End Sub
Function SheetExists(s As String) As Boolean
Dim x
On Error GoTo NextSheet
x = ActiveWorkbook.Sheets(SheetName).Name
SheetExists = True
Exit Function
NextSheet:
SheetExists = False
End Function
Once you have your workbook open, you can enumerate the sheets by name and populate a pick list on a sheet in the VSC workbook...
Here is a different approach to your question. It is using a Timer after opening the new Workbook to ask you every 10 seconds if you are on the sheet you want to copy from. If you answer "Yes" it will copy. If you answer "no" it will restart the 10 second timer.
Sub GetFilePath()
Set MyFile = Application.FileDialog(msoFileDialogOpen)
With MyFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Set newWk = Workbooks.Open(FileSelected, , True)
'Open Selected Workbook and check in 10 seconds for Selected Sheet Name
Application.OnTime Now + TimeValue("00:00:10"), "CheckForSheet"
End Sub
Private Sub CheckForSheet()
Dim SheetName As String
SheetName = ActiveSheet.Name
answer = MsgBox("Is This the Sheet to copy from: " & SheetName & "?", vbYesNo + vbQuestion, "Copy Data?")
If answer = vbYes Then
'ThisWorkbook is the workbook with the Macro/VBA code
'ActiveWorkbook is the workbook where you are selecting the Sheet to copy from
ActiveWorkbook.Sheets(SheetName).Range("B2:B5").Copy
ThisWorkbook.Sheets("Compare").Range("C1:C4").PasteSpecial
Else
'Check Again in 10 Seconds
Application.OnTime Now + TimeValue("00:00:10"), "CheckForSheet"
End If
End Sub
I am trying to write a code to copy a worksheet, to an open workbook. But I am getting a path error at the end.
The code looks like this right now;
Sub Storyboard_Ekle()
Dim DosyaSec As Office.FileDialog
Set DosyaSec = Application.FileDialog(msoFileDialogFilePicker)
With DosyaSec
.AllowMultiSelect = False
.Title = "Lütfen yeni eklenecek Storyboard dosyasini seçiniz."
.Filters.Clear
.Filters.Add "Excel Macro-Enabled Workbook", "*.xlsm"
.Filters.Add "Excel Workbook", "*.xlsx"
.Filters.Add "All Files", "*.*"
If .Show = True Then
YeniSB = .SelectedItems(1)
End If
Dim YeniStoryBoard As Workbook
Dim AnaDosya As Workbook
Dim YeniStoryBoard_Sheet As Worksheet
Dim AnaDosya_Sheet As Worksheet
Application.ScreenUpdating = False
Set AnaDosya = ThisWorkbook
YeniStoryBoard.Sheets("Storyboard").Copy After:=ThisWorkbook.Sheets("Kunye") '-> This gives error
YeniStoryBoard.Close
Set YeniStoryBoard_isim = Sheets("Storyboard")
YeniStoryBoard_isim.Name = "StoryboardXXYYZZ"
End With
End Sub
I am going to make some modifications on the code onwards, but this doesn't work properly. :(
Any suggestions?
Here is one-line code to solve your case:
Public Sub TestMe
ThisWorkbook.Worksheets("Storyboard").copy after:= ThisWorkbook.Worksheets("Kunye")
End Sub
It should work. Then start checking what does not work in your case line by line. I guess that the problem is that after Dim YeniStoryBoard As Workbook you do not set it. Thus, it is Nothing.
I am learning how to use Excel macros and I found this code:
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select the file to kill his non colored cells"
.Filters.Add "Excel", "*.xls"
.Filters.Add "All", "*.*"
If .Show = True Then
txtFileName = .SelectedItems(1)
End If
End With
This code opens the FileDialog. How can I open the selected Excel file without over-writing the previously opened?
Thankyou Frank.i got the idea.
Here is the working code.
Option Explicit
Private Sub CommandButton1_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "Excel 2003", "*.xls?"
If .Show = True Then
fileName = Dir(.SelectedItems(1))
End If
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open (fileName)
For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("import-sheets.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("import-sheets.xlsm").Worksheets(total)
Next sheet
Workbooks(fileName).Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Unless I misunderstand your question, you can just open a file read only.
Here is a simply example, without any checks.
To get the file path from the user use this function:
Private Function get_user_specified_filepath() As String
'or use the other code example here.
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Please select the file."
get_user_specified_filepath = fd.SelectedItems(1)
End Function
Then just open the file read only and assign it to a variable:
dim wb as workbook
set wb = Workbooks.Open(get_user_specified_filepath(), ReadOnly:=True)
I'm developing VBA code using Forms. I have a certain button option to let the user select the workbook using FileDialog. The workbook file may contain 4 or 5 sheets itself. I have combobox with empty.
I need to have the sheetnames of the user selected workbook listed in the combobox automaticaly without opening the workbook.
I tried with the following code, but got the names of already opened workbooks.
Private Sub CommandButton2_Click()
Set myfile = Application.FileDialog(msoFileDialogOpen)
With myfile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Fileselected = .SelectedItems(1)
End With
With Fileselected
For i = 1 To Sheets.Count
ComboBox2.AddItem Sheets(i).Name
Next i
End With
At the moment Sheets refers to the current workbook as you do nothing with Fileselected.
You must open the selected file, otherwise how can you examine its contents?
Set myfile = Application.FileDialog(msoFileDialogOpen)
With myfile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Fileselected = .SelectedItems(1)
End With
Dim doc As Workbook
Set doc = Application.Workbooks.Open(Fileselected)
With doc
For i = 1 To .Sheets.Count
ComboBox2.AddItem .Sheets(i).Name
Next i
.Close
End With