At "New folder" I have the excel workbooks which will be opened by the loop; I want to copy 2 columns in each of these workbooks and paste it in another workbook called "new"
When I run the code I get the Run-time error '91': Object variable or With block variable not set
at line With wb.Worksheets(5) and only data of the first workbook are copied.
How can I fix it?
Option Explicit
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook
Dim wbMain As Workbook
Dim i As Integer
Set wbMain = Workbooks.Open("C:\Users\A\Desktop\VBA\new.xlsx")
Pathname = "C:\Users\A\Desktop\VBA\New folder\"
Filename = Dir(Pathname)
i = 1
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
Enter_Formulas wb, wbMain, i
wb.Close SaveChanges:=True
Filename = Dir()
i = i + 2
Loop
End Sub
Sub Enter_Formulas(wb As Workbook, wbMain As Workbook, i)
With wb.Worksheets(5)
.Columns(1).Copy Destination:=wbMain.Worksheets(2).Columns(i)
.Columns(3).Copy Destination:=wbMain.Worksheets(2).Columns(i + 1)
End With
End Sub
You are telling VBA to copy columns A and C from the 5th worksheet of the opened workbook. Seems like it doesn't have five or more sheets.
Related
Wrote some code below to help me save some time saving files, the below is the shorter version which only saves one worksheet.
Sometimes it works perfectly, but most of the time it just silently crashes Excel with no error warning.
Nothing wrong while debugging... Not sure if ThisWorkbook.Sheets might be causing the issue?
Sub Save_CPC()
'Define the sheets to copy
Dim sheetsToCopy As Variant
sheetsToCopy = Array("RWF CPC")
'Create a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
'Loop through the sheets to copy
For i = 0 To UBound(sheetsToCopy)
'Copy the sheet to the new workbook
ThisWorkbook.Sheets(sheetsToCopy(i)).Copy Before:=newWorkbook.Sheets(1)
Next i
'Break links in the new workbook
newWorkbook.BreakLink Name:=ThisWorkbook.Name, Type:=xlExcelLinks
'Hide the sheet Sheet1 in new workbook
newWorkbook.Sheets("Sheet1").Visible = False
'Save the new workbook in the original folder
Dim saveName As String
saveName = ThisWorkbook.Sheets("Macros").Range("B13").Value
newWorkbook.SaveAs ThisWorkbook.Path & "\" & saveName & ".xlsx"
End Sub
Thanks in advance!!
Should copy and save worksheet as new spreadsheet with given name in current folder.
Copy Worksheets To a New Workbook
In One Go
Note that you can copy all the worksheets in one go as suggested by BigBen in the comments:
ThisWorkbook.Sheets(sheetsToCopy).Copy
Dim NewWorkbook As Workbook: Set NewWorkbook = Workbooks(Workbooks.Count)
The major drawback is that the worksheets in the new workbook will appear in the order they are appearing in the old workbook which may not necessarily be the order they are appearing in the array.
Additionally, at least one of the worksheets needs to be visible, and very hidden worksheets will not be copied.
Loop
Option Explicit
Sub SaveCPC()
' Start error-handling routine.
On Error GoTo ClearError
' Populate an array with the names of the worksheets to copy.
Dim sheetsToCopy() As Variant: sheetsToCopy = VBA.Array("RWF CPC")
' 'VBA.' ensures a zero-based array no matter what ('Option Base'-related).
' If you don't do this, instead of both occurrences of '0',
' use the recommended (more accurate) 'LBound(sheetsToCopy)'.
' Declare new variables to be used in the loop.
Dim NewWorkbook As Workbook, OldWorksheet As Worksheet, i As Long
' Loop through the worksheet names in the array.
For i = 0 To UBound(sheetsToCopy)
' Reference the worksheet to be copied.
Set OldWorksheet = ThisWorkbook.Sheets(sheetsToCopy(i))
If i = 0 Then ' on the first iteration...
' Add a new workbook containing only the first copied worksheet.
OldWorksheet.Copy
' Reference this new workbook.
Set NewWorkbook = Workbooks(Workbooks.Count)
Else ' on any but the first iteration
' Copy the worksheet as the last sheet in the new workbook.
OldWorksheet.Copy After:=NewWorkbook.Sheets(NewWorkbook.Sheets.Count)
End If
Next i
' Break links in the new workbook.
NewWorkbook.BreakLink Name:=ThisWorkbook.Name, Type:=xlExcelLinks
' Retrieve the base name of the new workbook.
Dim saveName As String
saveName = ThisWorkbook.Sheets("Macros").Range("B13").Value
' Save the new workbook in the original folder.
Application.DisplayAlerts = False ' overwrite without confirmation.
NewWorkbook.SaveAs ThisWorkbook.Path & "\" & saveName
Application.DisplayAlerts = True
' Inform.
MsgBox "CPC saved.", vbInformation
ProcExit:
Exit Sub
ClearError:
' Continue error-handling routine.
MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf & Err.Description
Resume ProcExit
End Sub
Here is my code of adding a sheet in multiple workbooks. I want to know how to skip or replace the exiting data in those multiple workbooks.
Sub AddingChklist()
ActiveWorkbook.Save
Dim path As String
Dim file As String
Dim Chklist As Workbook
path = "C:\Users\Documents\Macro Project\"
file = Dir(path)
Application.ScreenUpdating = False
Do While Not file = ""
Workbooks.Open (path & file)
Set Chklist = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Recon Checklist"
ThisWorkbook.Sheets("Recon Checklist").Range("A1:C25").Copy Destination:=Chklist.Sheets("Recon Checklist").Range("A1")
Range("A1:C25").EntireColumn.AutoFit
Range("A1:C25").EntireRow.AutoFit
Chklist.Save
Chklist.Close
file = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Checklist has been added to all the files"
End Sub
Copied from discussion below:-
My question was if the recon checklist sheet was already in one of the workbooks while running this macro. How we need to skip or replace the existing sheet.
Please try this code. In order to do away with the heavy flicker connected with opening many files in succession this procedure creates an invisible instance of Excel dedicated to this task. While this works very smoothly, it unfortunately raises the problem of not being able to copy formatting from one instance of Excel to another. Therefore my code only copies values. However, you have full access to each new sheet. For now only AutoFit is applied but you could do a lot of more formatting at that point if you feel the need.
Sub AddingChklist()
' 242
Const WsName As String = "Recon Checklist" ' Ws actual name
Dim Xl As New Excel.Application ' dedicated instance of Excel
Dim ChkList As Variant ' Checklist
Dim Path As String
Dim File As String
Dim Sp() As String ' split of File
Dim Wb As Workbook ' loop object
Dim Ws As Worksheet ' loop object: CheckList
Xl.Visible = True ' hide the newly opened workbooks
Path = "C:\Users\Documents\Macro Project\"
ChkList = ThisWorkbook.Sheets(WsName).Range("A1:C25").Value
File = Dir(Path)
Do While Not File = ""
Sp = Split(File, ".") ' process only Excel workbooks
If InStr(1, Sp(UBound(Sp)), "xls", vbTextCompare) = 1 Then
Set Wb = Xl.Workbooks.Open(Path & File)
Application.StatusBar = "Processing " & Wb.Name
On Error Resume Next
Set Ws = Wb.Worksheets(WsName)
If Err.Number = 9 Then
On Error GoTo 0
Set Ws = Wb.Sheets.Add(Before:=Wb.Sheets(1))
Ws.Name = WsName
End If
With Ws
.Cells.ClearContents
.Cells(1, 1).Resize(UBound(ChkList), UBound(ChkList, 2)).Value = ChkList
.Columns.AutoFit
.Rows.AutoFit
End With
Wb.Close SaveChanges:=True
End If
File = Dir
Loop
Xl.Quit ' close the dedicated instance of Excel
' MsgBox "Checklist has been added to all the files"
Application.StatusBar = "Checklist has been added to all the files"
End Sub
Observe that the code first looks for an existing tab by the same name. If such a sheet doesn't exist it will be created. Any existing sheet will be wiped clean. Finally, the contents of your template will be pasted to the new/clean sheet.
Note that I added a test to the code to ensure that only Excel workbooks will be processed.
I need to copy a couple of excel sheets ("Y", "X") from one file to the same sheet in another excel file (call it Z - the same file that I'm using the VBA on).
my limitation is that the name and path of the first excel file (with the X,Y) are changing, therefore I'm trying to write something more generic using the "as String" and the Application.GetOpenFilename() command but I'm receiving an error.
Tried to separate into 2 different subs
Sub BrowseForFile()
Dim sFileName As String
sFileName = Application.GetOpenFilename(, , "open the file: " )
If sFileName = "false" Then Exit Sub
MsgBox sFileName
Workbooks.Open (sFileName)
Workbooks(sFileName).Sheets("X").Activate
Stop
Runtime Error 9
file doesn't find (1004 I think)
If the user presses the Cancel button then the GetOpenFilename function returns a boolean False not a string "false" so you need to test for If sFileName = False Then and declare it as Variant.
If you open a workbook always reference it to a variable so you can use that to access the workbook easily
Dim OpenedWb As Workbook
Set OpenedWb = Workbooks.Open(sFileName)
Then you can use the variable Wb to reference the workbook you opened
OpenedWb.Worksheets("X").Activate
Note that using .Select and .Activate is a bad practice and should be avoided (How to avoid using Select in Excel VBA). Instead use another reference to reference your workbook.
Dim ws As Worksheet
Set ws = OpenedWb.Worksheets("X")
And access a range like ws.Range("A1").Value for example.
Sub BrowseForFile()
Dim sFileName As Variant 'needs to be variant because cancel returns a boolean False
sFileName = Application.GetOpenFilename(, , "open the file: " )
If sFileName = False Then Exit Sub
MsgBox sFileName
Dim OpenedWb As Workbook
Set OpenedWb = Workbooks.Open(sFileName)
Dim ws As Worksheet
Set ws = OpenedWb.Worksheets("X")
MsgBox ws.Range("A1").Value 'output the value of `A1` in worksheet `X` of workbook `sFileName`
End Sub
I want to copy a range of cells in my .csv file into a template.csv (named "pp"). Then I would like to save the template as "name of the original .csv file_2", without closing the original template as I would need it to do this procedure in loop for all the files in my folder. I have come up with this code that doesn't work:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim pp As Workbook ' Workbook to receive the copied data
Dim ppSht As Worksheet ' Worksheet where copied data will be inserted
Dim Wkb As Workbook ' Temporary workbook for the Loop
Dim Sht As Worksheet ' Temporary worksheet variable for the loop
MyFile = Dir("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT*.csv*")
Set pp = Workbooks("pp.csv")
Set ppSht = pp.Sheets("Sheet1")
Do While MyFile <> ""
Set Wkb = Workbook.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
Set Sht = Wkb.Worksheets("sheet1")
Sht.Range("A1:G113").Copy
With ppSht
.Range("A1:G113").PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = MyFile_2.csv
Wkb.Close True
MyFile = Dir
Loop
End Sub
I am new to the vba coding and I am not sure what I am doing wrong as I don't get any error messages, the code simply doesn't run. Do you have any suggestion?
First of all I would like to recommend you how to use a CSV file (Comma-separated values). By this a csv file does not have any sheets. Therefore you can reach the worksheet with the following, there wb is the workbook. Another good advice is to use Option Explicit that enables some error codes, example if you get to initialize a variable.
Dim pp As Workbook
pp.Worksheets (1)
Do While MyFile <> ""
Set wb = Workbooks.Open("R:\COMT study\Silvia\Cognitive data\COMT 1\Tasks\CPT" & MyFile)
With wb.Worksheets(1)
Range(A1,G113).copy
End With
With ppSht
.Range(A1,G113).PasteSpecial xlPasteFormulas
End With
pp.SaveCopyAs Filename = "MyFile_2.csv"
'Remove the wb.Close if you want the sheet to stay open (Not recommended if there are many files)
wb.Close
MyFile = Dir
loop
Try using some of this (Haven't tried it so just use it as a template). See if you can get any errors or at least if you can collect the data from the file into a array.
I'm merging Excel workbooks into one "summary.xls" using a VBA macro. The macro is executed from another open workbook. This original workbook has some formulas containing links to "summary" (like ='C:\[Summary.xls]Cell'!E3). For the process of merging, the original workbook "summary.xls" is deleted and rewritten. After rewriting all the formulas with the original links to summary have #ref! written in it and are broken and can not be automatically updated (='C:\[Summary.xls]#REF'!E4). The following passage is the one causing the mistake:
Workbooks(Filename).Close (False) 'add False to close without saving
' Kill srcFile 'deletes the file
Filename = Dir()
Does somebody has a suggestion how to solve the problem?
Whole code is based on that suggestion:
Option Explicit
Function IsSheetEmpty(sht As Worksheet) As Boolean
IsSheetEmpty = Application.WorksheetFunction.CountA(sht.Cells) = 0
End Function
Sub GetSheets()
Dim Path, Filename As String
Dim Sheet As Worksheet
Dim newBook As Workbook
Dim appSheets As Integer
Dim srcFile As String
Dim dstFile As String
Application.ScreenUpdating = False 'go faster by not waiting for display
'--- create a new workbook with only one worksheet
dstFile = ActiveWorkbook.Path & "AllSheetsHere.xlsx"
If Dir(dstFile) <> "" Then
Kill dstFile 'delete the file if it already exists
End If
appSheets = Application.SheetsInNewWorkbook 'saves the default number of new sheets
Application.SheetsInNewWorkbook = 1 'force only one new sheet
Set newBook = Application.Workbooks.Add
newBook.SaveAs dstFile
Application.SheetsInNewWorkbook = appSheets 'restores the default number of new sheets
Path = "C:\Temp\"
Filename = Dir(Path & "*.xls?") 'add the ? to pick up *.xlsx and *.xlsm files
Do While Filename <> ""
srcFile = Path & Filename
Workbooks.Open Filename:=srcFile, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
'--- potentially check for blank sheets, or only sheets
' with specific data on them
If Not IsSheetEmpty(Sheet) Then
Sheet.Copy After:=newBook.Sheets(1)
End If
Next Sheet
Workbooks(Filename).Close (False) 'add False to close without saving
Kill srcFile 'deletes the file
Filename = Dir()
Loop
'--- delete the original empty worksheet and save the book
newBook.Sheets(1).Delete
newBook.Save
newBook.Close
Application.ScreenUpdating = True 're-enable screen updates
End Sub
Internal sheet-to-sheet references within a workbook (Book1.xlsx) generally look like this:
=ABC!B23
But if you copy the worksheet with that reference to a new workbook, Excel will change it to an external reference back to the original workbook:
='[Book1.xlsx]ABC'!B23
There are several restrictions you'll have to place on references in your worksheets that you're copying into the single new workbook:
All sheet names in the destination workbook MUST be unique
Sheets named "ABC" in Book1 and "ABC" in Book2 would cause reference collisions in the destination workbook
One of the sheets must be renamed into a unique string
Sheet-to-sheet references that are completely internal to a workbook can be converted into similar references in the destination. References to external worksheets (in a different workbook) may be problematic and could require lots of additional logic to handle.
One option is to perform a wildcard search and replace on a worksheet after the Sheet.Copy is performed. The requirement here is that any sheet that is referenced must already be local to the new sheet in the destination book. (Otherwise, the "fixed-up" reference will still give you a #REF error.)
Sub test()
Dim area As Range
Dim farea As Range
'--- determines the entire used area of the worksheet
Set area = Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
'--- replaces all external references to make them internal references
area.Replace What:="[*]", Replacement:=""
End Sub
The other option is much cleaner and a neat trick. When you're copying worksheets into a new workbook, if you copy ALL the sheets in a single action then Excel preserves the sheet-to-sheet references as internal (and doesn't replace each reference with a filename prefix) because it knows that the sheet references will be there in the new workbook. Here's that solution in your code:
Option Explicit
Function IsSheetEmpty(sht As Worksheet) As Boolean
IsSheetEmpty = Application.WorksheetFunction.CountA(sht.Cells) = 0
End Function
Sub GetSheets()
Dim i As Integer
Dim Path, Filename As String
Dim sh As Worksheet
Dim newBook As Workbook
Dim appSheets As Integer
Dim srcFile As String
Dim dstFile As String
Dim dstPath As String
Dim wasntAlreadyOpen As Boolean
Dim name As Variant
Dim allSheetNames As Dictionary 'check VBA Editor->Tools->References->Microsoft Scripting Runtime
Dim newSheetNames As Dictionary
Dim newNames() As String
Application.ScreenUpdating = False 'go faster by not waiting for display
'--- create a new workbook with only one worksheet
dstFile = "AllSheetsHere.xlsx"
dstPath = ActiveWorkbook.Path & "\" & dstFile
wasntAlreadyOpen = True
If Dir(dstPath) = "" Then
'--- the destination workbook does not (yet) exist, so create it
appSheets = Application.SheetsInNewWorkbook 'saves the default number of new sheets
Application.SheetsInNewWorkbook = 1 'force only one new sheet
Set newBook = Application.Workbooks.Add
newBook.SaveAs dstPath
Application.SheetsInNewWorkbook = appSheets 'restores the default number of new sheets
Else
'--- the destination workbook exists, so ...
On Error Resume Next
wasntAlreadyOpen = False
Set newBook = Workbooks(dstFile) 'connect if already open
If newBook Is Nothing Then
Set newBook = Workbooks.Open(dstPath) 'open if needed
wasntAlreadyOpen = True
End If
On Error GoTo 0
'--- make sure to delete any/all worksheets so we're only left
' with a single empty sheet named "Sheet1"
Application.DisplayAlerts = False 'we dont need to see the warning message
Do While newBook.Sheets.Count > 1
newBook.Sheets(newBook.Sheets.Count).Delete
Loop
newBook.Sheets(1).name = "Sheet1"
newBook.Sheets(1).Cells.ClearContents
newBook.Sheets(1).Cells.ClearFormats
Application.DisplayAlerts = True 'turn alerts back on
End If
'--- create the collections of sheet names...
' we need to make sure that all of the sheets added to the newBook have unique
' names so that any formula references between sheets will work properly
' LIMITATION: this assumes sheet-to-sheet references only exist internal to
' a single workbook. External references to sheets outside of the
' source workbook are unsupported in this fix-up
Set allSheetNames = New Dictionary
allSheetNames.Add "Sheet1", 1
Path = "C:\Temp\"
Filename = Dir(Path & "*.xls?") 'add the ? to pick up *.xlsx and *.xlsm files
Do While Filename <> ""
srcFile = Path & Filename
Workbooks.Open Filename:=srcFile, ReadOnly:=True
'--- first make sure all the sheet names are unique in the destination book
Set newSheetNames = New Dictionary
For Each sh In ActiveWorkbook.Sheets
If Not IsSheetEmpty(sh) Then
'--- loop until we get a unique name
i = 0
Do While allSheetNames.Exists(sh.name)
sh.name = sh.name & "_" & i 'rename until unique
i = i + 1
Loop
allSheetNames.Add sh.name, i
newSheetNames.Add sh.name, i
End If
Next sh
'--- we're going to copy ALL of the non-empty sheets to the new workbook with
' a single statement. the advantage of this method is that all sheet-to-sheet
' references are preserved between the sheets in the new workbook WITHOUT
' those references changed into external references
ReDim newNames(0 To newSheetNames.Count - 1)
i = 0
For Each name In newSheetNames.Keys
newNames(i) = name
i = i + 1
Next name
ActiveWorkbook.Sheets(newNames).Copy After:=newBook.Sheets(1)
Workbooks(Filename).Close (False) 'add False to close without saving
Kill srcFile 'deletes the file
'--- get the next file that matches
Filename = Dir()
Loop
'--- delete the original empty worksheet and save the book
If newBook.Sheets.Count > 1 Then
newBook.Sheets(1).Delete
End If
newBook.Save
'--- leave it open if it was already open when we started
If wasntAlreadyOpen Then
newBook.Close
End If
Application.ScreenUpdating = True 're-enable screen updates
End Sub
If you still have reference in your workbook to the cells being referenced (and from your example, you do), and if all of your #REF! errors used to point to a single sheet, there is an easy fix.
CTRL+H brings up the REPLACE function.
Simply enter #REF! in the "find" box, and Sheet1 in the "replace" box, and all references will now point to sheet1 in the same summary.xls workbook.
I've added a further workbook containig the referencins formulas. This one is closed during the whole procedure of deleting and summarizing the worksheets. The new workbook opens after this, therefore the referencing mistake is avoided.