I have 1 active workbook and adding another multiple workbooks basis on column data
and same saving with Basis on Next function and giving value of column
Need to activate new added workbook but problem is every time workbook name is different basis on column hence unable to activate the same basis on name
Help to activate another workbook
Activate the another workbook (previous workbook) without declaring name
If you're adding new workbooks, they're normally activated, then you can use ActiveWorkbook.Name, if you're however opening workbooks depending on a cell's value, you can use that when setting it to a Workbook object.
In this example, the paths to workbooks are in the A-column:
Sub openWorkbooksFromVariables()
Dim Lastrow As Long, i As Long
Dim wbQ As Workbook, wbB As Workbook
Dim qPath As String
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Set wbB = ActiveWorkbook 'current workbook is now accessible through wbB
For i = 2 To Lastrow
qPath = "" & Range("A" & i).Value & ""
Set wbQ = Workbooks.Open(qPath)
wbQ.Activate
wbQ.Save
wbQ.Close
Next i
End Sub
If there's anything more needed, please update your question with an example.
Related
I'm hoping someone can help with this but I'm having the darnest time getting anything to work.
I have a rather large workbook with lots of worksheets, I have a report that runs and populates Column B with a "trigger"
Column A: is the name of all the worksheets in the workbook. Column B is the indicator that the specific worksheet needs to be moved, e.g. "Yes". I need to move the specified workbook into another workbook.
I can only find applicable examples for moving cells but it didn't work. Any help or direction will be greatly appreciated!
Dim WBK As Workbook
Dim WBK2 As Workbook
Set WBK= ThisWorkbook
Set WBK= Workbooks.Open(Filename:"ReportList.xlsx")
For i = 1 To Sheets("MoveSheet").End(xlDown).Row '(ERRORHERE)
If Sheets("MoveSheet").Range("B" & i) = "Move" Then
Sheets(Sheets("MoveSHeet").Range("A" & i)).Move After:=wkbk2.Sheets(1)
Else
End if
Next i
End Sub
Your posted code is not too far off - a few typos etc
Try this:
Sub Tester()
Dim wb As Workbook, wsList As Worksheet, c As Range
Dim wbDest As Workbook
Set wb = ThisWorkbook
Set wsList = wb.Worksheets("MoveSheet") 'your sheet with tab names and "Move" flag
Set wbDest = Workbooks.Open(Filename:="C:\Example\Path\ReportList.xlsx") 'provide the full path
For Each c In wsList.Range("A1:A" & wsList.Cells(Rows.Count, "A").End(xlUp).Row).Cells
If c.Offset(0, 1).Value = "Move" Then 'has a flag to be moved?
wb.Worksheets(c.Value).Move after:=wbDest.Sheets(wbDest.Sheets.Count) 'move after last sheet
End If
Next c
End Sub
Maybe a for each loop would be good.
Dim wkbk1 As Workbook - Main workbook
Dim wkbk2 As Workbook - Your other workbook
Set wkbk1 = ActiveWorkbook
Set wkbk2 = "input name here"
Dim ws As Worksheet
For Each ws In wkbk1.Sheets
'use if code to check if certain Criteria met'
ws.Move wkbk2.Sheets(Sheets.Count)
Next ws
I would have one loop to run through column A and check if the sheet needs to be move by checking the column B right alongside it. If column B contains the trigger, which would be checked with a if condition, then move the sheet to another workbook.
For i = 1 To Sheets("Sheet1").Range("A1").End(xlDown).Row
If Sheets("sheet1").Range("B" & i) = "Yes" Then
Sheets(Sheets("sheet1").Range("A" & i)).Move After:=Workbooks("Otherworkbook.xls").Sheets(1)
Else
End If
Next i
Something like this but might need to declare the second workbook with the full filename and directory.
I am setting up VBA code which does the following when run:
Runs a loop to open Excel files in a folder, one by one
Every time that an Excel file is opened, a password unprotects the worksheet and unmerges cells
Once the cells are unmerged, the data from the Excel file is copied and pasted to specific cells in the workbook where the VBA code is originally saved/stored
Upon pasting the data, the opened Excel workbook from the loop now closes (not necessary to save), and the next workbook is opened, where the next set of data is placed one row below the previous row
The VBA code is run from a workbook which always remains open, we can call it "Workbook 1.xlsm" In this instance for the code below, the use of wbPaste as the active workbook is intended to reference "Workbook 1.xlsm". Because the name of the workbook is going to change every month that this is run, I wanted to declare a workbook by using a naming convention that would reference the name, regardless of what the workbook is called.
The files that are in the folder can have various names, and could be in the hundreds of total files. I have declared most of the variables and have had success in getting the Excel workbooks to open from the folder. Unprotecting the sheet, and unmerging the cells has given some problems, however. I think that the issue that I am experiencing comes with looping the opening of the workbooks and which workbook is considered "active" at the time.
Sub OpenFilesForExtraction()
'declaration of variables
Dim myFolder As String
Dim myFile As String
Dim wbCopy As Workbook
Dim wbPaste As Workbook
Dim lastRow As Long
'setting up name of folder and file type (any Excel file in folder) for the loop
myFolder = "C:\Users\Me\Desktop\Folder 1\"
myFile = Dir(myFolder & "*.xl??")
lastRow = 3
'start of loop
Do While myFile <> ""
Workbooks.Open fileName:=myFolder & myFile
'wbCopy is the Excel file that gets unprotected, unmerged and data is copied from. wbPaste will be where the data gets copied to. wbPaste is referencing the workbook where the macro is stored. By declaring these files in the loop, wbCopy should take on the name of the next file opening from the folder
Set wbCopy = Workbooks(myFile)
Set wbPaste = ActiveWorkbook
'Unprotecting and unmerging from the file wbCopy, that was opened by the loop statement
wbCopy.Unprotect Password:="Password1"
wbCopy.Unprotect
Range("C15:E15").Select
Selection.UnMerge
Range("H15:J15").Select
Selection.UnMerge
Range("C17:E17").Select
Selection.UnMerge
Range("B23:C23").Select
Selection.UnMerge
Range("B29:C29").Select
Selection.UnMerge
Range("B31:J37").Select
Selection.UnMerge
'Copying and pasting the information from the files that are being opened to the file wbPaste. Note that the range for where the value is pasted is determined by the value of "lastRow" variable, which is designed to paste information starting with the cells in row 3, then moving to row 4, row 5, and so on....
wbCopy.Range("C13").Value = wbPaste.Range("A" & lastRow).Value
wbCopy.Range("C15").Value = wbPaste.Range("B" & lastRow).Value
wbCopy.Range("H15").Value = wbPaste.Range("D" & lastRow).Value
wbCopy.Range("C17").Value = wbPaste.Range("I" & lastRow).Value
wbCopy.Range("J17").Value = wbPaste.Range("H" & lastRow).Value
wbCopy.Close
lastRow = lastRow + 1
myFile = Dir
Loop
End Sub
The program reaches a point where it will open up the first file from the folder, however, I get an immediate error after that. I think that there are two potential reasons.
First, I am not certain if I should use anything related to ActiveWorkbook. The reason why is because as I loop through opening the Excel documents in the folder, the VBA code may not understand which is meant to be the ActiveWorkbook at certain times.
Second, the Unmerging and copy/paste of values is where this will stop the program. I have had some chances to allow the cells to unmerge, but I think it came at the cost of calling out the wbCopy file as an ActiveWorkbook, when it really isn't meant to be called out as an active workbook.
There are a number of issues here
Relying on ActiveWorkbook when opening books changes what's active
Using Select
Your copy/paste is reversed
Unnecessary second Unprotect
Not using ThisWorkbook (you say you specifically want to paste into the book containing the VBA code)
Refering to Range's on Workbooks, instead of Worksheets
Your code, refactored
Sub OpenFilesForExtraction()
'declaration of variables
Dim myFolder As String
Dim myFile As String
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim wsPaste As Worksheet
Dim lastRow As Long
'setting up name of folder and file type (any Excel file in folder) for the loop
myFolder = "C:\Users\Me\Desktop\Folder 1\"
myFile = Dir(myFolder & "*.xl??")
lastRow = 3
'start of loop
Set wsPaste = ThisWorkbook.Worksheets("NameOfSheetToPasteOn")
Do While myFile <> vbNullString
'wbCopy is the Excel file that gets unprotected, unmerged and data is copied from. wbPaste will be where the data gets copied to. wbPaste is referencing the workbook where the macro is stored. By declaring these files in the loop, wbCopy should take on the name of the next file opening from the folder
Set wbCopy = Workbooks.Open(Filename:=myFolder & myFile)
'Unprotecting and unmerging from the file wbCopy, that was opened by the loop statement
wbCopy.Unprotect Password:="Password1"
Set wsCopy = wbCopy.Worksheets("NameOfSheetToCopyFrom")
With wsCopy
'wbCopy.Unprotect
.Range("C15:E15").UnMerge
.Range("H15:J15").UnMerge
.Range("C17:E17").UnMerge
.Range("B23:C23").UnMerge
.Range("B29:C29").UnMerge
.Range("B31:J37").UnMerge
'Copying and pasting the information from the files that are being opened to the file wbPaste.
'Note that the range for where the value is pasted is determined by the value of "lastRow" variable,
'which is designed to paste information starting with the cells in row 3, then moving to row 4, row 5, and so on....
wsPaste.Range("A" & lastRow).Value = .Range("C13").Value
wsPaste.Range("B" & lastRow).Value = .Range("C15").Value
wsPaste.Range("D" & lastRow).Value = .Range("H15").Value
wsPaste.Range("I" & lastRow).Value = .Range("C17").Value
wsPaste.Range("H" & lastRow).Value = .Range("J17").Value
End With
wbCopy.Close False
lastRow = lastRow + 1
myFile = Dir
Loop
End Sub
Ignoring what my code actually does (it's not important to my question):
I want to be able to open my excel file, press a button, have the code use data in that workbook and another opened workbook (so I would have two workbooks opened at the same time, the macro runs in one of them but can take data from both of them).
The trick here is that I can't seem to find code to access the other workbook that I've opened up, so I can only take info from the active workbook.
For example,
Private Function GetLastRow() As Integer
Dim myLastRow As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
myLastRow = Range("C" & Rows.count).End(xlUp).Row
GetLastRow = myLastRow
End Function
This code lets me access the active workbook (the one running the code), using ThisWorkbook.
Is there another function capable of allowing me to access another opened workbook?
You could change your function to be more flexible.
Private Function GetLastRow(InWorksheet As Worksheet, InColumn As Variant) As Long
GetLastRow = InWorksheet.Cells(InWorksheet.Rows.Count, InColumn).End(xlUp).Row
End Function
So you can call it …
Sub Test()
Dim LastRow As Long
LastRow = GetLastRow(ThisWorkbook.Worksheet("Sheet1"), "C") 'column as letter
'or
'LastRow = GetLastRow(ThisWorkbook.Worksheet("Sheet1"), 3) 'column as number
End Sub
So you can even run this on another workbook using:
LastRow = GetLastRow(Workbooks("OtherWorkbook.xlsx").Worksheet("Sheet1"), "C") 'column as letter
There is a Workbook object built into VBA that you can use. This documentation should give you the information that you need https://learn.microsoft.com/en-us/office/vba/api/excel.workbook
You would simply put the name of your other workbook in quotes, in parentheses after using the Workbook object (see example on page I hyperlinked). Good luck!
I guess this is what you looking for.
When you have more then one Workbook active you can switch between then.
Sub GetLastRow()
Dim myLastRow As Integer
'Active Workbook
Set ws = ThisWorkbook.Sheets("Plan1")
myLastRow = ws.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow
'Way when you know workbook name
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Teste1.xlsx"
Set ws1 = Application.Workbooks("Teste1.xlsx").Sheets("Plan1")
myLastRow1 = ws1.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow1
Dim myLastRow As Integer
'If you don't know the name but, opened after your main Workbook
Set ws3 = Application.Workbooks(2).Sheets("Plan1")
myLastRow3 = ws1.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow3
End Sub
I have a few hundred or so excel files in a directory each with a unique identifier somewhere in the name, 103, 208c, 231a, etc. Identifiers are housed in a column in the workbook with the code. Based on these identifiers I'm trying to dynamically open the workbook containing the string of text and paste a single cell to be next to it's workbooks identifier.
I tried to get it to work for a single case below but after the would be dynamic file opens the macro ends rather than selecting the value and pasting it. If anyone has any suggestions on how to fix that or how to switch this code from single case to dynamic/loop based I'd greatly appreciate it. I'm relatively new to coding VBA. Normally only need to rarely read it/step thru existing code.
Option Explicit
Sub Process()
On Error Resume Next
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim sFound As String, fPath As String
Dim BaseFile As Workbook
Dim TestSheet As Worksheet
Dim WB1 As Workbook
Set TestSheet = ThisWorkbook.Sheets("TestSheet")
Set BaseFile = ThisWorkbook
fPath = "\\WhateverDirectory\"
sFound = Dir(fPath & "*231a*") '231a should be values in column B row 4 on in the TestSheet
If sFound <> "" Then
Set WB1 = Workbooks.Open(fPath & sFound)
WB1.Sheets("RCM").Range("D6").Copy
BaseFile.Activate
TestSheet.Range("C4").PasteSpecial xlPasteValues
End If
I've got a workbook with two spreadsheets named "WT-1" and "CL-1" (it could be more of them with diff. names).
When i.e. "WT-1" is active, I would like to be able to (by using a button with macro assigned to it) copy this current (active) spreadsheet and rename it in sequence like WT-2, WT-3, WT-4 etc .
I guess change needs to apply only to spreadsheets who's name contains "WT-" as the name change should be addressed to the new sheet only. All other existing worksheets should not be touched. here it is - Pls help :) It changes name of one new spreadsheet. If there is more than just 1 worksheet in my workbook, it doesn't work.
Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left(Trim(ws.Name), 3) = "WT-" Then
ws.Name = shtName(i)
i = i + 1
End If
Next ws
End Sub
Macro is suppose just to change the name of a new and freshly copied spreadsheet. So if I copy WT-2 and create new sheet named WT-2(2) and run macro - it will work and change new sheet name to WT-1 (being first name in the range on 'wslist') . That seems to be OK. But, if I have any other spreadsheet in my workbook (except active sheet and already copied new sheet) it doesn't work and gives me an error 1004 - "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"
When I click on de-bag, this I found highlighted: ws.Name = shtName(i)
The issue is if you have the situation with following sheets
WT-1
WT-1 (2)
WT-2
Your code tries to rename WT-1 (2) into WT-2 but that already exists.
So a possibility was you would need to rename these to something else first like
WT-1
#WT-2
#WT-3
and then remove the # in another loop.
This way you prevent renaming into a name that already exists.
Option Explicit
Public Sub changeWSname()
Dim ws As Worksheet
Dim shtName As Variant
Dim Rng As Range
Dim i As Long
With Sheets("wslist")
Set Rng = .Range("A1", .Range("A" & .Rows.Count).End(xlUp).Address)
shtName = Application.Transpose(Rng)
i = LBound(shtName)
End With
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 3) = "WT-" Then
'test if we run out of sheet names
If i > UBound(shtName) Then
MsgBox "Running out of sheet names … aborting"
Exit Sub
End If
ws.Name = "#" & shtName(i) 'add a # to all new sheet names
i = i + 1
End If
Next ws
'remove the # from the sheet nam
For Each ws In ActiveWorkbook.Worksheets
If Left$(Trim(ws.Name), 1) = "#" Then
ws.Name = Right$(ws.Name, Len(ws.Name) - 1)
End If
Next ws
End Sub
As QHarr pointed out it's probably a good idea to test if you are running out of sheet names.