Open file, select sheet and copy it to file with macro - excel

this is my first post. I would like to have a code which would let user to choose file with filedialog then populate sheet names from the file to userform and copy selected sheet to workbook with the code.
Private wbSource As Workbook
Private wsSource As Worksheet
Private Sub UserForm_Initialize()
Dim I As Long
Dim filedlg As FileDialog
Set filedlg = Application.FileDialog(msoFileDialogFilePicker)
With filedlg
.Title = "Please select a file to list Sheets from"
.InitialFileName = ThisWorkbook.Path
.ButtonName = "Select"
If .Show <> -1 Then End
End With
Set wbSource = Workbooks.Open(filedlg.SelectedItems(1))
Me.ComboBox1.Clear
With wbSource
For I = 1 To .Worksheets.Count
Me.ComboBox1.AddItem Sheets(I).Name
Next
End With
End Sub
Private Sub ComboBox1_Click()
Set wsSource = wbSource.Worksheets(Me.ComboBox1.Value)
wsSource.Copy ThisWorkbook.Sheets(Sheets.Count)
wbSource.Close SaveChanges:=False
Unload Me
End Sub
The code is working until excel tries copy the sheet, there is a Run-time error 9 - Subscript out of range. Did I declare variables wrongly?

Related

Use the same workbook in multiple modules

I have a workbook with two buttons. So an user can press them to open two workbooks (Input and Output). Then he will copy data from Input to Output. My problem here is that I don't know how to define the same workbook for my subs.
This is the code for opening the files:
Public wb1 As Workbook
Public wb2 As Workbook
Public result As Integer
Public fDialog As FileDialog
Public Sub inputs()
Set fDialog = Application.FileDialog(msoFileDialogOpen)
Set control = Workbooks("Control.xlsm").Worksheets("Control")
fDialog.Title = "Select a file"
fDialog.Title = "Select a file"
If fDialog.Show = -1 Then
If Right(fDialog.SelectedItems(1), 5) = ".xlsx" Or Right(fDialog.SelectedItems(1), 4) = ".xls" Then
Set wb1 = Workbooks.Open(fDialog.SelectedItems(1))
control.Cells(6, 2) = fDialog.SelectedItems(1)
Else
MsgBox ("Please select an excel file")
Exit Sub
End If
End If
End Sub
This is the other sub for copying data:
Public Sub stack()
For Each ws In wb1.Worksheets
'---here is the code for copying data---
Exit For
Exit Sub
When I run this code, of course it gives me this error "object variable or With block not set".
Do you know how can I resolve this? How can I use the same wb1 for both subs?
It's better to limit the scope of your variable whenever possible so what you can do is this:
Public Sub stack()
Dim wbControl As Worksheet
Set wbControl = Workbooks("Control.xlsm").Worksheets("Control")
'Check if there is possible input path in cell B6
If wbControl.Cells(6, 2).Value2 = vbNullString Then
MsgBox "Provide the Input workbook path first!"
Exit Sub
End If
'Check if there is possible output path in cell B6
If wbControl.Cells(6, 2).Value2 = vbNullString Then
MsgBox "Provide the Output workbook path first!"
Exit Sub
End If
'More error checking - e.g. check if both path are valid (file exist?)
Dim wbInput As Workbook
Set wbInput = Workbooks.Open(wbControl.Cells(6, 2).Value2) 'Input path in cell B6
Dim wbOutput As Workbook
Set wbOutput = Workbooks.Open(wbControl.Cells(6, 5).Value2) 'Output path in cell E6
Dim ws As Worksheet
For Each ws In wbInput.Worksheets
'Do whatever you want in here
Next ws
'Remember to close the workbook if not needed later
End Sub
Remove this line from your inputs sub (and also similar one for selecting the output file)
Set wb1 = Workbooks.Open(fDialog.SelectedItems(1))
Please, use the next way:
Declare public variables for both necessary workbooks, on top of the standard module:
Public wb1 As Workbook, wb2 As Workbook
Copy the next sub in a standard module, to open and Set the necessary workbooks:
Sub SetWorbooks()
Dim fdialog As FileDialog, i As Long
Set fdialog = Application.FileDialog(msoFileDialogFilePicker)
For i = 1 To 2
fdialog.Title = "Please, select """ & IIf(i = 1, "Input", "Output") & """ file"
If fdialog.Show = -1 Then
If Right(fdialog.SelectedItems(1), 5) = ".xlsx" Or Right(fdialog.SelectedItems(1), 4) = ".xls" Then
If i = 1 Then
Set wb1 = Workbooks.Open(fdialog.SelectedItems(1))
Else
Set wb2 = Workbooks.Open(fdialog.SelectedItems(1))
End If
Else
MsgBox "Please select an excel file (xls, xlsx)!"
Exit Sub
End If
Else
MsgBox "You should select an Excel file...": Exit Sub
End If
Next i
End Sub
Then use them in this way:
Sub Mystack()
Dim ws As Worksheet
If wb1 Is Nothing Then SetWorbooks 'for cases when having an error and the wb(s) reference have been lost.
For Each ws In wb1.Worksheets
'---here is the code for copying data---
Next
End Sub

How can I open multiple files to copy data into a master workbook in new tab?

I have a master Excel file that needs to inherit data from .csv files.
When I run the VBA, it will pop up the file explorer, let me select multiple files and loop over them and create new sheets.
When I try to copy the data into the sheet that it created, it gives me a type mismatch error.
Sub OpenLMSFiles()
Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim tempWB As Workbook
Dim i As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "Libraries\Documents"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True
FileChosen = fd.Show
If FileChosen = -1 Then
For i = 1 To fd.SelectedItems.Count
Set tempWB = Workbooks.Open(fd.SelectedItems(i))
Call ReadDataFromSourceFile(tempWB)
Next i
End If
End Sub
Private Sub ReadDataFromSourceFile(src As Workbook)
Application.ScreenUpdating = False
ThisWorkbook.Sheets.Add
Workbooks(src).Worksheets(src.ActiveSheet).Range("A1:Z500").Copy _
Workbooks(ThisWorkbook).Worksheets(ThisWorkbook.ActiveSheet).Range("A1:Z500")
End Sub
The cause of the error is the way you are referencing workbooks and worksheets, which are collections that take index arguments (integer or string). For example you can reference a workbook as Workbooks(1) (bad idea) or Workbooks("FileName.xlsx") (better). Similarly use Sheets(1) or Sheets("SheetName").
src is a Workbook -> simply use src.Sheets(). Because csv files have only 1 worksheet it is safe to use src.Worksheets(1) (Sheets and Worksheets are equivalent).
Anyway, here is a working code. I rearranged the code as I think ReadDataFromSourceFile should encapsulate opening and closing the csv file as well as reading data from it (only an opinion)
Sub ImportLMSFiles()
Dim fd As FileDialog
Dim FileChosen As Long
Dim FileName As String
Dim i As Long
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.InitialFileName = "Libraries\Documents"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True
FileChosen = fd.Show
If FileChosen = -1 Then
For i = 1 To fd.SelectedItems.Count
Call ReadDataFromSourceFile(fd.SelectedItems(i))
Next i
End If
End Sub
Private Sub ReadDataFromSourceFile(sSrcFilename As String)
' Validate the name
If Right(sSrcFilename, 4) <> ".csv" Then Exit Sub
Application.ScreenUpdating = False
Dim shtDest As Worksheet: Set shtDest = ThisWorkbook.Sheets.Add
Dim wbSrc As Workbook: Set wbSrc = Workbooks.Open(sSrcFilename)
' csv files have only 1 sheet
' UsedRange is exactly what it sounds like
With wbSrc.Sheets(1)
.UsedRange.Copy shtDest.Range(.UsedRange.Address)
' if you want to rename the new sheet
' Bug: another sheet might have the same name -> u need check for that
' Here I'm just ducking it: name not changed
On Error Resume Next
shtDest.Name = .Name
On Error GoTo 0
End With
wbSrc.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

Copy data from different workbook and paste it to specific sheets on a report workbook

Currently i am new on studying VBA for reporting and im still learning from it. moving on, may i ask a help on this one? :), my scenario is this.
i have data on 20 workbooks (POLY, BAYO, PROPO, TIPAS, CITRO....etc) with sheet name (Sheet1)
i have a single workbook for summary with many sheets, its sheet name is based on 20 workbook file name but not in alphabetical order. (Sheet name = CITRO, BAYO, PROPO, POLY, TIPAS....etc)
i want to copy the data on each workbook and paste it to their respective sheet name based on file name and specific cell ("B2:F2")
is it doable?
here's the code im trying to work on, the problem is, it is creating its own sheet instead of pasting it to my desire sheet.
Private Sub CommandButton1_Click()
Dim SourceBook As Workbook
Dim CurrentBook As Workbook
application.screenupdating = false
Set CurrentBook = ThisWorkbook
Set SourceBook = Workbooks.Open("C:\CITRO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("CITRO").Range("R2:V2")
Set SourceBook = Workbooks.Open("C:\BAYO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("BAYO").Range("R2:V2")
Set SourceBook = Workbooks.Open("C:\PROPO.xlsx")
SourceBook.Sheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Sheets("PROPO").Range("R2:V2")
MsgBox "Completed"
Application.Workbooks("CITRO").Close
Application.Workbooks("BAYO").Close
Application.Workbooks("PROPO").Close
'SourceBook.Close
'Set SourceBook = Nothing
'Set CurrentBook = Nothing
'ThisWorkbook.Activate
'Application.Worksheets("Summary").Activate
'Application.Worksheets("Summary").Range("B2:F2").Select
End Sub
You need to close the SourceBook before opening a new one with SourceBook.Close SaveChanges:=False
Private Sub CommandButton1_Click()
Dim SourceBook As Workbook
Dim CurrentBook As Workbook
Application.ScreenUpdating = False 'don't forget to activate it in the end
Set CurrentBook = ThisWorkbook
Set SourceBook = Workbooks.Open("C:\CITRO.xlsx")
SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("CITRO").Range("R2:V2")
SourceBook.Close SaveChanges:=False
Set SourceBook = Workbooks.Open("C:\BAYO.xlsx")
SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("BAYO").Range("R2:V2")
SourceBook.Close SaveChanges:=False
Set SourceBook = Workbooks.Open("C:\PROPO.xlsx")
SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=CurrentBook.Worksheets("PROPO").Range("R2:V2")
SourceBook.Close SaveChanges:=False
Application.ScreenUpdating = True
MsgBox "Completed"
End Sub
Alternatively you can use a procedure to shorten it:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False 'don't forget to activate it in the end
CopyIntoThisWorkbook "C:\CITRO.xlsx", "CITRO"
CopyIntoThisWorkbook "C:\BAYO.xlsx", "BAYO"
CopyIntoThisWorkbook "C:\PROPO.xlsx", "PROPO"
Application.ScreenUpdating = True
MsgBox "Completed"
End Sub
Private Sub CopyIntoThisWorkbook(ByVal SourceFileName As String, ByVal DestinationSheetName As Range)
Dim SourceBook As Workbook
Set SourceBook = Workbooks.Open(SourceFileName)
SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=ThisWorkbook.Worksheets(DestinationSheetName).Range("R2:V2")
SourceBook.Close SaveChanges:=False
End Sub
And if the sheet name CITRO is always the filename CITRO.xlsx then you can even use an array with a loop:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False 'don't forget to activate it in the end
Dim SheetNameList() As Variant
SheetNameList = Array("CITRO", "BAYO", "PROPO") 'easily extendable
Dim SheetName As Variant
For Each SheetName In SheetNameList
CopyIntoThisWorkbook SheetName
Next SheetName
Application.ScreenUpdating = True
MsgBox "Completed"
End Sub
Private Sub CopyIntoThisWorkbook(ByVal DestinationSheetName As String)
Dim SourceBook As Workbook
Set SourceBook = Workbooks.Open("C:\" & DestinationSheetName & ".xlsx")
SourceBook.Worksheets("Sheet1").Range("B2:F2").Copy Destination:=ThisWorkbook.Worksheets(DestinationSheetName).Range("R2:V2")
SourceBook.Close SaveChanges:=False
End Sub

VBA/Excel - Copy worksheet to another workbook (Replace existing values)

I am trying to copy the values from one sheet, into another workbooks sheet. However I can't get Excel to actually paste the values to the other workbook.
This my code.
Sub ReadDataFromCloseFile()
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim src As Workbook ' SOURCE
Dim currentWbk As Workbook ' WORKBOOK TO PASTE VALUES TO
Set src = openDataFile
Set currentWbk = ActiveWorkbook
'Clear existing data
currentWbk.Sheets(1).UsedRange.ClearContents
src.Sheets(1).Copy After:=currentWbk.Sheets(1)
' CLOSE THE SOURCE FILE.
src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
And below is the function openDataFile which is used to get the source workbok (File Dialog):
Function openDataFile() As Workbook
'
Dim wb As Workbook
Dim filename As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Select the file to extract data"
' Optional properties: Add filters
fd.Filters.Clear
fd.Filters.Add "Excel files", "*.xls*" ' show Excel file extensions only
' means success opening the FileDialog
If fd.Show = -1 Then
filename = fd.SelectedItems(1)
End If
' error handling if the user didn't select any file
If filename = "" Then
MsgBox "No Excel file was selected !", vbExclamation, "Warning"
End
End If
Set openDataFile = Workbooks.Open(filename)
End Function
When I try to run my Sub, it opens the src file and just stops there. No values are copied and pasted to my currentWbk
What am I doing wrong?
Maybe my sub will help u
Public Sub CopyData()
Dim wb As Workbook
Set wb = GetFile("Get book") 'U need use your openDataFile here
Dim wsSource As Worksheet
Set wsSource = wb.Worksheets("Data")'enter your name of ws
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets.Add
wsSource.Cells.Copy ws.Cells
wb.Close False
End Sub

VBA Use variable value across modules

I'm trying to use the name of a workbook which I set in module 1, across other private modules but I'm getting different errors depending on how I set it up. I added comments in the code that explain what happens in the different scenarios.
Option Explicit
Sub TestSharedVars()
CopyCellsthenClose
OpenNewWksheet (AlphaExportBook)
' *** Like this
' OpenNewWksheet (AlphaExportBook) I get "Error Variable not defined"
' *** Like this
' OpenNewWksheet I get "Error Argument not optional"
CloseWkbook
End Sub
Private Sub CopyCellsthenClose()
Dim AlphaExportBook As Workbook
Dim theRows
Dim theColumns
With ActiveSheet.UsedRange
theRows = .Rows.Count
theColumns = .Columns.Count
Range(Cells(1, 1), Cells(theRows, theColumns)).Select
End With
Selection.Copy
Set AlphaExportBook = ActiveWorkbook
End Sub
Private Sub OpenNewWksheet()
'******************************
' Open the File Dialog
'******************************
Dim ReversionWBook As Workbook
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
.Execute
If (.SelectedItems.Count = 0) Then
MsgBox "User Cancelled Operation"
' GoTo EndofInstructions
Else
End If
End With
ActiveWorkbook.Activate
Set ReversionWBook = ActiveWorkbook
End Sub
Private Sub CloseWkbook(AlphaExportBook As Workbook)
'**********************************
' Close Alpha Export WorkBook
'**********************************
AlphaExportBook.Activate
Application.DisplayAlerts = False
AlphaExportBook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Firstly, you shouldn't be getting an "Argument not optional" error when calling OpenNewWksheet because that subroutine is not expecting arguments. You would get that error trying to call CloseWkbook without specifying a parameter, because that subroutine expects a Workbook object to be passed to it.
The easiest way to make the workbook available to all subroutines is to declare the variable with module-level scope, e.g.
Option Explicit
Dim AlphaExportBook As Workbook
Sub TestSharedVars()
CopyCellsthenClose
OpenNewWksheet
CloseWkbook
End Sub
Private Sub CopyCellsthenClose()
Dim theRows
Dim theColumns
With ActiveSheet.UsedRange
theRows = .Rows.Count
theColumns = .Columns.Count
'Note - the following line won't do what you expect unless
' UsedRange starts at cell A1
Range(Cells(1, 1), Cells(theRows, theColumns)).Select
End With
Selection.Copy
Set AlphaExportBook = ActiveWorkbook
End Sub
Private Sub OpenNewWksheet()
'******************************
' Open the File Dialog
'******************************
Dim ReversionWBook As Workbook ' Does this need to be module-level scope too?
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
.Execute
If .SelectedItems.Count = 0 Then
MsgBox "User Cancelled Operation"
End If
End With
'ActiveWorkbook.Activate ' This is redundant - the ActiveWorkbook is already active
Set ReversionWBook = ActiveWorkbook
End Sub
Private Sub CloseWkbook()
'**********************************
' Close Alpha Export WorkBook
'**********************************
'You don't need to activate the workbook before you close it
'AlphaExportBook.Activate
Application.DisplayAlerts = False
AlphaExportBook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Alternatively, you could pass the workbook object between subroutines as follows:
Option Explicit
Sub TestSharedVars()
'Dimension object to have scope only within this subroutine, but we
' will pass a reference to this object to the other subroutines that
' need to reference it
Dim AlphaExportBook As Workbook
CopyCellsthenClose AlphaExportBook
OpenNewWksheet
CloseWkbook AlphaExportBook
End Sub
Private Sub CopyCellsthenClose(wb As Workbook)
Dim theRows
Dim theColumns
With ActiveSheet.UsedRange
theRows = .Rows.Count
theColumns = .Columns.Count
'Note - the following line won't do what you expect unless
' UsedRange starts at cell A1
Range(Cells(1, 1), Cells(theRows, theColumns)).Select
End With
Selection.Copy
Set wb = ActiveWorkbook
End Sub
Private Sub OpenNewWksheet()
'******************************
' Open the File Dialog
'******************************
Dim ReversionWBook As Workbook ' Does this need to be module-level scope too?
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
.Execute
If .SelectedItems.Count = 0 Then
MsgBox "User Cancelled Operation"
End If
End With
'ActiveWorkbook.Activate ' This is redundant - the ActiveWorkbook is already active
Set ReversionWBook = ActiveWorkbook
End Sub
Private Sub CloseWkbook(wb As Workbook)
'**********************************
' Close Alpha Export WorkBook
'**********************************
'You don't need to activate the workbook before you close it
'wb.Activate
Application.DisplayAlerts = False
wb.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub

Resources