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
Related
I have a macro that works in any Excel workbook but doesn't work once I place it in my PERSONAL.XLSB file. My goal is to take the tabs from all of the files in a folder on my desktop and copy them into the active file. I know the issue is that I am using This.Workbook as the location reference for the copied tabs but I don't know how else to reference the workbook I am trying to copy the tabs into. I don't want to reference a filepath for where to copy the tabs since this will be used by multiple people in multiple files. Any thoughts would be greatly appreciated.
Sub CombineWorkbooks()
Dim Path As Variant
Path = GetFolder(1) & "\"
Dim FileName As String
FileName = Dir(Path & "*.xl??")
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open Path & FileName
For Each ws In ActiveWorkbook.Sheets
ws.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Next ws
Workbooks(FileName).Close
FileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End Sub
If you define the file to a variable or activeworkbook it should work.
UPDATED as I think I slightly misunderstood the overall objective of macro but the concept is still the same. Let me know if this doesn't work.
Sub CombineWorkbooks()
Dim Path As Variant
Path = GetFolder(1) & "\"
Dim FileName As String
FileName = Dir(Path & "*.xl??")
Dim ws As Worksheet, wkBkToCopyTo As Workbook
Set wkBkToCopyTo = ActiveWorkbook 'assuming that you run this with the destination open.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open Path & FileName
For Each ws In ActiveWorkbook.Sheets
ws.Copy after:=wkBkToCopyTo.Worksheets(wkBkToCopyTo.Worksheets.Count)
Next ws
Workbooks(FileName).Close
FileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End Sub
You could also try to find it based on its name:
'you could also use a loop to find it
For Each wkBkToCopyTo In Application.Workbooks
If InStr(1, wkBkToCopyTo.Name, "someNameof the workbook", vbTextCompare) > 0 Then
Exit For
End If
Next wkBkToCopyTo
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
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
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
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