I'm trying to get a permanent reference to two specific workbooks, but when looking at the locals window, they do not
I've tried referencing ThisWorkbook.Name as well, but it does not seem to solve the issue. It always seem to go back to referencing Workbook/ThisWorkbook.
Sub Import_data()
Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook
Set WB1 = ThisWorkbook
sFound = Dir(ActiveWorkbook.path & "\*Name.xlsx") 'the first one found
If sFound <> "" Then
Workbooks.Open Filename:=ActiveWorkbook.path & "\" & sFound
Set WB2 = ActiveWorkbook
End If
WB2.Worksheets("Sheet2").Range("A5").Copy _
WB1.Worksheets("Sheet2").Range("K18")
End Sub
I get the subscript out of range error when I run the sub.
Try This:
Sub Import_data()
Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook
Set WB1 = ActiveWorkbook
sFound = Dir(ActiveWorkbook.Path & "\*Name.xlsx") 'the first one found
If sFound <> "" Then
Set WB2 = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\" & sFound)
WB2.Worksheets("Sheet2").Range("A5").Copy
WB1.Worksheets("Sheet2").Range("K18").PasteSpecial xlPasteValues
End If
End Sub
Change
Workbooks.Open Filename:=ActiveWorkbook.path & "\" & sFound
Set WB2 = ActiveWorkbook
to
Set WB2=Workbooks.Open(ActiveWorkbook.path & "\" & sFound)
If you want a clean code : never use ActiveWorkbook !
Try this :
Sub Import_data()
Dim wb As Workbook
Dim sFound As String, WB1 As Workbook, WB2 As Workbook
Set WB1 = ThisWorkbook
sFound = Dir(WB1.path & "\*Name.xlsx") 'the first one found
If sFound <> "" Then
Set WB2 = Workbooks.Open(Filename:=WB1.path & "\" & sFound)
WB2.Worksheets("Sheet2").Range("A5").Copy _
WB1.Worksheets("Sheet2").Range("K18")
End If
End Sub
Related
I am looking to unhide the exact same named sheet in multiple workbooks. The worksheet is called ADMIN_Export. All the workbooks are in the same directory.
I've looked around and haven't been able to find something to fit this exactly, been trying to work around it with limited coding background and have come close. This is close: How can I run one VBA macro on all the (closed) Excel files in a folder?
So I am using this, but need the actual
Sub unhide()
Dim myfiles, wb As Workbook, ws As Worksheet
myfiles = Dir(Thisworkbook.Path & "\*.xlsx")
Do While Len(myfiles) <> 0
Debug.Print myfiles
'~~> Should this be read-only? Or just regular open?
Set wb = Workbooks.Open(Thisworkbook.Path & "\" & myfiles, , True)
'~~> This is where I need help with unhiding
wb.Close False
Set wb = Nothing '~~> clean up
myfiles = Dir
Loop
End Sub
Thanks in advance for your help.
Actually this should work:
Sub unhide()
Dim myfiles, wb As Workbook, ws As Worksheet
myfiles = Dir(ThisWorkbook.Path & "\*.xlsm")
Do While Len(myfiles) <> 0
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & myfiles)
wb.Sheets("ADMIN_Export").Visible = xlSheetVisible
wb.Save
wb.Close False
'or instead of save use wb.Close True
Set wb = Nothing
myfiles = Dir
Loop
End Sub
Sub unhide()
Dim myfiles, wb As Workbook, ws As Worksheet
myfiles = Dir(ThisWorkbook.Path & "\*.xlsm")
Do While Len(myfiles) <> 0
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & myfiles, , True)
Workbooks.Open myfiles
Sheets("ADMIN_Export").Visible = True
wb.Close True
Set wb = Nothing
myfiles = Dir
Loop
End Sub
For the first time thanks for this macro! I have a little problem. I need 'resave' many workbooks with many worksheets as values. I used this code :
But this code 'resave' only first workbook and other only opened. Where is the problem?
Thanks for your help
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
Dim wsh As Worksheet
For Each wsh In ThisWorkbook.Worksheets
wsh.Cells.Copy
wsh.Cells.PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End With
xFileName = Dir
Loop
End If
End Sub
You could try something like the following:
Sub OpenFiles()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim MyFolder As String
Dim MyFile As String
Dim wbCurrent As Workbook
Dim wsh As Worksheet
MyFolder = "Enter Folder directory here"
MyFile = Dir(MyFolder & "\*.xlsm")
Do While MyFile <> ""
Set wbCurrent = Workbooks.Open(Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False)
For Each wsh In wbCurrent.Worksheets
wsh.Cells.Copy
wsh.Cells.PasteSpecial xlPasteValues
Next
wbCurrent.Close SaveChanges:=True
MyFile = Dir
Loop
End Sub
If all your workbooks are in the same folder, this will open each one, copy and paste the cells in each worksheet, then Save, before moving onto the next workbook.
ThisWorkbook refers to the workbook with the macro in it. If you want to refer to other workbooks you need to define variables for them. Run this simple macro when several workbooks are open to get the idea, and then adjust to your needs.
Option Explicit
Sub test()
Dim wk As Workbook
For Each wk In Workbooks
MsgBox "this workbook is named: " & wk.Name
Next
End Sub
I'm trying to open two separate workbooks via VBA in Excel and, somehow, the same code lines work in one case, but do not in the second one.
My first code line works properly:
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
The second one, however, do not, it does open the file, but do not store it as wb2 and returns a Mistype error.
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1,UpdateLinks:=xlUpdateLinksNever)
[EDIT] This is the whole code set:
Option Explicit
Sub Update_Supply_Concerns()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim wb, WB1, WB2 As Workbooks
Dim ws, ws1, ws2 As Worksheets
Dim path, path1, path2 As String
Dim fName, fName1, fName2 As String
Dim uName As String
Dim rDate As String
Dim fExt, fExt1 As String
uName = Environ$("username")
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Macro")
With ws
.Activate
rDate = .Range("D6").Value
path = "C:\Users\" & uName & "\Documents\Projects\" & rDate & "\"
fName = "Hospital"
fExt = ".xlsx"
path1 = "C:\Users\" & uName & "\Box Sync\Supply Concerns 2.0\"
fName1 = "Supply Concerns v2"
fExt1 = ".xlsx"
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1, UpdateLinks:=xlUpdateLinksNever)
End With
End Sub
I've tried activating the parent workbook before attempting to open the second file, with no success.
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
wb.Activate
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1, UpdateLinks:=xlUpdateLinksNever)
A problem is that
Dim wb, WB1, WB2 As Workbooks
doesn't do what you think it does. It declares wb, WB1 as simple Variants and then declares WB2 as a Workbooks (note the "s"!) object. It doesn't declare any of those three variables as a Workbook object.
Since WB1 is a variant (which can hold a workbook object) the line
Set WB1 = Workbooks.Open(path & fName & fExt, UpdateLinks:=xlUpdateLinksNever)
is unproblematic. But since WB2 is declared to be a workbooks object, the line
Set WB2 = Workbooks.Open(path1 & fName1 & fExt1,UpdateLinks:=xlUpdateLinksNever)
is a type mismatch since you are trying to use a workbooks variable to hold a workbook object.
To start fixing your code, use the declaration:
Dim wb As Workbook, WB1 As Workbook, WB2 As Workbook
(and fix some of your other declarations as well).
Fetch Sheet1 Data From Multiple Workbook Into Single Workbook Using VBA Or Macros
Option Explicit
Sub MergeExcels()
Dim Path As String, FName As String
Dim wb As Workbook
Dim ws As Worksheet
Path = ""
FName = Dir(Path & "*.xlsx")
With ThisWorkbook
Do While FName <> ""
Set wb = Workbooks.Open(Path & FName, ReadOnly:=True)
For Each ws In wb.Worksheets
ws.Copy After:=.Sheets(.Sheets.Count)
Next ws
wb.Close SaveChanges:=False
FName = Dir()
Loop
End With
End Sub
Above Code Fetch All Sheets In a Workbook But I Need Sheet1 Data Only
Change:
For Each ws In wb.Worksheets
ws.Copy After:=.Sheets(.Sheets.Count)
Next ws
To:
wb.Worksheets("Sheet1").Copy After:=.Sheets(.Sheets.Count)
Or, if you meant the first worksheet instead of the one named Sheet1:
wb.Worksheets(1).Copy After:=.Sheets(.Sheets.Count)
Option Explicit
Sub MergeExcels()
Dim Path As String, FName As String
Dim wb As Workbook
Dim ws As Worksheet
Path = "D:\BILL'S\Thankam\2019\June\Bills"
FName = Dir(Path & "*.xlsx")
With ThisWorkbook
Do While FName <> ""
Set wb = Workbooks.Open(Path & FName, ReadOnly:=True)
wb.Worksheets("Sheet1").Copy After:=.Sheets(.Sheets.Count)
wb.Close SaveChanges:=False
FName = Dir()
Loop
End With
End Sub
Option Explicit
Sub MergeExcels()
Dim Path As String, FName As String
Dim wb As Workbook
Dim ws As Worksheet
Path = "D:\BILL'S\Thankam\2019\June\Bills"
FName = Dir(Path & "*.xlsx")
With ThisWorkbook
Do While FName <> ""
Set wb = Workbooks.Open(Path & FName, ReadOnly:=True)
wb.Worksheets(1).Copy After:=.Sheets(.Sheets.Count)
wb.Close SaveChanges:=False
FName = Dir()
Loop
End With
End Sub
As the title suggests, this code fails on the line Sheet.Copy After:=ThisWorkbook.Sheets(1) with runtime error 1004
Why would this run when added as a module but not when saved as an add-in?
Here's the code:
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = GetFolder() & "\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
As #BruceWayne suggested is a problem with deciding the correct workbook. As an AddIn, ThisWorkbook will be the AddIn workbook, while ActiveWorkbook (before opening others), will be the workbook you are running your AddIn into.
Simply replacing Thisworkbook with ActiveWorkbook in your scenario won't work, because you would just copy the sheets from the newly open workbook, to the same.
Is a good idea to declare variables to hold this informations, then you can open as many workbooks as you want, and from where you want.
See below:
Application.ScreenUpdating = False
Dim wbDst As Workbook: Set wbDst = ActiveWorkbook 'Can also use Worbooks("book name here")
Dim wbSrc As Workbook
Dim Sht As Worksheet
Dim FolderPath As String: FolderPath = GetFolder() & "\"
Dim FileName As String: FileName = Dir(FolderPath & "*.xls*")
Do While FileName <> ""
Set wbSrc = Workbooks.Open(FileName:=FolderPath & FileName, ReadOnly:=True)
For Each Sht In wbSrc.Worksheets
Sht.Copy After:=wbDst.Sheets(1)
Next Sht
wbSrc.Close
FileName = Dir()
Loop
Application.ScreenUpdating = True