I have N number of sheets in an excel file. now I want to convert all of the sheets into .csv format Using bash shell scripting And before converting the xlxs file to .csv I need to add extra columns to each sheet with common value at the end. Please help
I agree with the other comment, can't this be done through excel?
Example solution if you choose this approach:
' Forces all variables to be declared
Option Explicit
Sub WorksheetLoop()
' Define variable types
Dim WS_Count As Integer
Dim I As Integer
Dim currentWorkSheet As String
Dim PathName As String
' Stop screen from flickering while code is running
Application.ScreenUpdating = False
' Set WS_Count equal to the number of worksheets in the active workbook
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
' Find name of the current sheet
currentWorkSheet = ActiveWorkbook.Worksheets(I).Name
' Go to the current sheet
Worksheets(currentWorkSheet).Activate
' Add extra column on that sheet
' Select rows in the extra column where the formula is to be added
Range("D1:D10").Select
' Add the formula (example formula, multiplying previous column by 1)
Selection.FormulaR1C1 = "=RC[-1]*1"
' Export to CSV
' Copy the current worksheet
ActiveWorkbook.Sheets(currentWorkSheet).Copy after:=ActiveWorkbook.Sheets(currentWorkSheet)
' Rename the current worksheet
Sheets(ActiveSheet.Name).Name = currentWorkSheet & "_export"
' Export the excel to csv
' Create path and name for export
PathName = "" & ThisWorkbook.Path & ActiveSheet.Name & ".csv"
' Move sheet to seperate workbook
Sheets(ActiveSheet.Name).Move
' Save as CSV file
ActiveWorkbook.SaveAs Filename:=PathName, FileFormat:=xlCSV
' Close that CSV with the SAVE warnings surpressed
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Next I
Application.ScreenUpdating = True
End Sub
To run the code use the vba editor (shortcut to open the editor ALT+F11). Open a new macro, paste the code, then you can use F8 to step through each line
Related
I have never don't VBA scripting, or macros.
However I need to copy pasting a lot of excel documents into one. So I was wondering how I could implement the following (or what direction to head):
I need to copy a table of x rows and y columns but there are many empty rows. And a lot of rows are merged. I need to copy this to another file and unmerge the rows and copy the content to all of the merged columns.
There are multiple files like this and need to go into one file. Each file has varying amount of sheets.
If anything is there anyways I can just created a macro to copy and paste only non empty columns and unmerge the merged columns and have the same data between all the merged rows?
This is a partial answer, which does not address the processing of the individual sheets. It does give you a framework to start with.
Sub Process_Workbooks()
'Process a Collection of workbooks
Dim arrPathandFile, FilePointer As Long
Dim strPathAndFile As String
Dim bkSource As Workbook, shInput As Worksheet
Dim bkDestination As Workbook, shResult As Worksheet
Dim myPath, PathandFile As String
arrPathandFile = Application.GetOpenFilename("Audit Files (*.xls*), *.xlsx, All Files (*.*), *.*", , "Select Workbooks to process", "", True)
' user cancels file selection
If Not IsArray(arrPathandFile) Then Exit Sub
'Create a place to put the results
Set bkDestination = Workbooks.Add
'For each file in the collectin
For FilePointer = 1 To UBound(arrPathandFile)
strPathAndFile = arrPathandFile(FilePointer)
'Open the workbook
Set bkSource = Workbooks.Open(strPathAndFile)
'process each worksheet
For Each shInput In bkSource.Sheets
Set shResult = bkDestination.Sheets.Add
shResult.Name = shInput.Name & "(" & FilePointer & ")"
'figure out the source range to copy
shInput.Range("A1:Z900").Copy Destination:=shResult.Range("A1")
'now do stuff to the sheet in the destination.
Call Do_Stuff_To_sheets(shInput)
'repeat for each sheet in the workbook
Next shInput
bkSource.Close
'repeat for each workbook selected
Next FilePointer
'save the results
bkDestination.SaveAs myPath & "NewFilename.xlsx"
End Sub
Private Sub Do_Stuff_To_sheets(mySheet As Worksheet)
'process each sheet to unmerge and defrag columns
End Sub
I nearly have this done, except nothing is being pasted. MY PROBLEM: The exporting and save functions seems to work as it creates a new workbook and saves, but it is empty.
I am having the user select which worksheet they want to extract a static range from (the variable is the worksheet). Each sheet is named by the week number (52 separate worksheets) plus a couple of background data sheets, which offsets the worksheet visible name from what excel calls the worksheet by 4. Meaning sheet1 is called "Labor", while sheet5 is called "1" - for the first week of the year.
Anyways, that variable is passed through the lstExportInvoiceWeek combobox by the user. from that selection, I want to copy a static range (BA6:BT200) and then paste it into a csv file.
Here is my code. The pasting isn't working. The new workbook is saving blank.
Private Sub cmbInvoicesExport_Click()
Application.ScreenUpdating = False
Dim CurrentFileName As String
CurrentFileName = ActiveWorkbook.Name
Debug.Print "Active File: " + CurrentFileName
Dim wsexport As String
wsexport = cboExportInvoiceWeek.Value
Worksheets(wsexport).Activate
Worksheets(wsexport).Unprotect
Range("BA6:BT200").Copy
Workbooks.Add Template:="Workbook"
Range("A1").Select
ActiveSheet.Paste
Dim file_name As Variant
file_name = Application.GetSaveAsFilename(FileFilter:="CSV (Comma delimited) (*.csv), *.csv")
If file_name <> False Then
ActiveWorkbook.SaveAs Filename:=file_name
MsgBox "File Saved!"
End If
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.CutCopyMode = False
Workbooks(CurrentFileName).Activate
Application.ScreenUpdating = True
End Sub
Avoid using ActiveSheet Instead use Workbooks("YourWorkbook.xls").Worksheets("Sheet1").Activate
You need to reference the Workbook target to paste the data.
I am looking for a macro to paste some data onto a moving range. I already have a cell that tells me the number of the next non empty column and this is the code I currently use:
Dim OpenFileName As String
Dim wb As Workbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename()
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName)
'Get data EXAMPLE
ThisWorkbook.Sheets("Teleselling 17").Range("I9:I289")*this should be dynamic, I want to paste data in a moving range*.Value = wb.Sheets("TELESELLING INBOUND").Range("L9:L289").Value
wb.Close SaveChanges:=False
MsgBox ("Done!")
Use the newly opened workbook/worksheet/range to define the scope of the value transfer.
with wb.workSheets("TELESELLING INBOUND").Range("L9:L289")
ThisWorkbook.workSheets("Teleselling 17").Range("XFD9").end(xltoleft).offset(0, 1).resize(.rows.count, .columns.count) = .value
end with
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.
Need help with a macro that will open 5 different csv files and automatically auto copy paste 3 columns of data (starting from the 2nd row to about the 200th row). Then the data will be pasted into one worksheet that is open so each file is all on one row (side by side)...any help will be appreciated..
Sub Macro2()
'Assign variable name to Target workbook
Var1 = ActiveWorkbook.Name
'Assign variable name to Target range
Var1R = "H1"
'Open Source WorkBook
Application.Workbooks.Open ("C:\MY DOCUMENTS\WORKBOOK(B).xls")
'Assign variable name to Source workbook
Var2 = ActiveWorkbook.Name
Var2R = "WORKSHEET-1"
'Copy from Source to Target
Sheets(Var2R).Columns("F").EntireColumn.Copy _
Destination:=Workbooks(Var1).Sheets("Sheet1").Range(Var1R)
'Close Source WorkBook wo/Save
Workbooks(Var2).Close False
End Sub
Here is a program that will do that. Obviously you'll have to modify the file-paths and ranges.
Sub copy_paste()
Dim filepaths
Dim twb As Workbook
Dim x As Long
Set twb = ThisWorkbook
filepaths = Array("C:\A.csv", "C:\B.csv", "C:\C.csv", "C:\D.csv", "C:\E.csv")
For x = 1 To UBound(filepaths)+1
With Workbooks.Open(filepaths(x-1))
.Sheets(1).Range("A2:C200").Copy twb.Sheets(1).Cells(2, 3 * x - 2)
.Close False
End With
Next x
End Sub