I have 141 excel sheets. I need two columns from each sheet evantually dumped into one giant csv file. This is what I have so far:
Sub ColumnCopytoCSV()
'
' ColumnCopytoCSV Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Range("C:C,H:H").Select
Range("H1").Activate
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
strFileFullName = ThisWorkbook.FullName
ActiveWorkbook.SaveAs Filename:=strFileFullName & ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWindow.Close
End Sub
A few problems...
1) Excel requires my personal workbook to be open, but "ThisWorkBook" keeps pulling "Personal" instead FileX, and FileY's names. I would like the exported files to be named FileX.csv and FileY.csv, based on where they were pulled from.
2) Once the naming is correct, would I simply use the Append commands to patch all of the files together?
Related
I have been working with the VBA code below and the code worked fine (creating a file with a .csv extension.
Today, my firm had an Office 365 update and for some reason the same code without edit, creates a file with a .CSV extension making it unable to be read by certain progams (it needs to be edited with the lowercase extension to be used further).
What do I need to know/alter in my settings to make my code run like prior?
Sub CSV_transfer()
Dim header As Range
Dim rngToSave As Range
Application.DisplayAlerts = False
Windows("file.xlsm").Activate
'Add a new sheet to become your csv and paste data
Sheets.Add After:=ActiveSheet
Set header = Sheets("sheet1").Range("AY3:AY6")
header.Copy
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Set rngToSave = Sheets("sheet1").Range("AX3:AX450")
rngToSave.Copy
ActiveSheet.Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'Move the sheet into it's own instance
ActiveSheet.Move
'Rename the tab
ActiveSheet.Name = "export"
'Save the WB as a CSV and close
ActiveWorkbook.SaveAs FileName:="*path*\export", _
FileFormat:=xlCSV, CreateBackup:=False, Local:=True
ThisWorkbook.Saved = True
ActiveWindow.Close
Application.DisplayAlerts = True
End Sub
If you specify the file extension, this might solve your problem. Instead of using the default (now .CSV), try changing:
ActiveWorkbook.SaveAs FileName:="*path*\export"
to:
ActiveWorkbook.SaveAs FileName:="*path*\export.csv"
I have a Macro that copies and pastes from one excel document to another. For some reason, I had an error when using pastespecial immediately after copying and pasting from the other source doc. So as a workaround I just pasted normally, and then copied it again and then used pastespecial. My problem is that when running this Macro for some reason it adds a space to the end of the numbers turning them into text. Meaning that my graphs don't recognize them.
Workbooks.Open (fileLocation & "/" & fileName & fileType)
Worksheets(sourceWorksheet).Select
rowInUse = 46 'Add data row and name of sheet being imported into
mySheet = "sheet2"
pasteLocation = "D5"
lastColumn = ActiveSheet.Cells(rowInUse, Columns.Count).End(xlToLeft).Column
Range(Cells(rowInUse, firstColumn), Cells(rowInUse, lastColumn)).Copy
ActiveWorkbook.Close SaveChanges:=False
Worksheets(mySheet).Select
Range(tempPasteLocation).Select
ActiveSheet.Paste
Sheets(mySheet).Select
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.Copy
Range(pasteLocation).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.ClearContents
Does anyone have any idea why this is happening or how to fix it?
Thank you
Perform a direct value transfer instead of Copy, PasteSpecial, Values.
Replace,
Sheets(mySheet).Select
Range(tempPasteLocation, Cells(tempRow, tempColumn + lastColumn)).Select
Selection.Copy
Range(pasteLocation).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
With this,
with workSheets(mySheet)
with .Range(tempPasteLocation, .Cells(tempRow, tempColumn + lastColumn))
.Range(pasteLocation).resize(.rows.count, .columns.count) = .value2
end with
end with
I am writing an excel macro that will copy a sheet from 1 workbook and create a new workbook and remove all the calculations in it.
The problem I am having is copying the logo over. When I run my macro it will hang from time to time either on the picture copy or the picture paste.
This is what I have. I have tried(as you can see from the commented out lines) several fixes.
Sub CopySheets(Actbook As String, newfilestr As String, filestr As String,Sheetstr As String)
'
' NewPriceSheets Macro
'
'
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=newfilestr, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows(Actbook).Activate
Worksheets(Sheetstr).Activate
Cells.Select
Selection.Copy
Windows(filestr).Activate
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows(Actbook).Activate
Worksheets(Sheetstr).Shapes("Picture 1").Copy
'ActiveSheet.Shapes.Range(Array("Picture 1")).Copy
'Selection.Copy
Windows(filestr).Activate
'Range("A1").Select
'ActiveSheet.Paste
Worksheets(1).Paste Range("A1")
'Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
Windows(Actbook).Activate
I am trying to automate a process. We receive a report that has multiple companies billing information. We currently paste this report into an excel document and it filters out to individual worksheets for each separate company.
We have a macro that copy, paste values to a new worksheet and saves the file. The problem is that the macro saves a file for every worksheet in the excel file and I want to adapt the macro so that it only saves the file where there is billing information for that month.
Therefore we don't have new worksheets saved down, with no billing for the customer.
Currently the macro is set up as below for every customer worksheet.
eg:'BGNBINS
Sheets("BGNBINS").Select
Cells.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
'Save the new workbook and close it
ActiveWorkbook.SaveAs Filename:= _
"G:\ACCTG RV\Breena's Admin & JDE\Weighbridge Reports (Breena)\3rd Party Tonnes\Customers 3rd Party\06.2015\BGNBINS 0615 WTS.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
'CONSOLW
Sheets("CONSOLW").Select
Cells.Select
Selection.Copy
Workbooks.Add
'Paste special values and formats
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'resize to fit gridlines
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.DisplayGridlines = False
Range("A1").Select
Application.CutCopyMode = False
'save and close file in specified drive and name
ActiveWorkbook.SaveAs Filename:= _
"G:\ACCTG RV\Breena's Admin & JDE\Weighbridge Reports (Breena)\3rd Party Tonnes\Customers 3rd Party\06.2015\CONSOLW 0615 WTS.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Sorry you are a bit vague on how the sheet works but is this what you are after?
If ActiveSheet.Range("a1") > 0 Then
'Save the new workbook and close it
ActiveWorkbook.SaveAs Filename:="File Path", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
End If
The error that I am receiving is Run-time error '9': Subscript out of range.
Sub Workbook_Open()
'Turn off any alerts that maybe displayed.
Application.DisplayAlerts = False
'Turn of the screen updates
Application.ScreenUpdating = False
'Declare the workbook, create it, save it and close it
Dim wk As Workbook
Set wk = Workbooks.Add
wk.SaveAs Filename:="C:\Saved File\KPI_Grid.xlsm", FileFormat:=52, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
wk.Close
'Open the workbook again. This will get rid of the 'Compatibilty View' and then activate the orginal workbook
Application.Workbooks.Open Filename:="C:\Saved File\KPI_Grid.xlsm"
Workbooks("KPI Grid V5K1 - macro testing.xlsm").Activate
Worksheets("Weekly").Activate
'Select all cells and copy them
Cells.Select
Selection.Copy
'Activate the workbook and sheet that we are going to paste into.
Workbooks("KPI_Grid.xlsm").Activate
Worksheets("Sheet1").Activate ' ******************ERROR HERE ******************
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Activate the previous workbook again.
Workbooks("KPI Grid V5k1 - macro testing.xlsm").Activate
Worksheets("Monthly").Activate
Cells.Select
Cells.Copy
Workbooks("KPI_Grid.xlsm").Activate
Worksheets("Sheet2").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
I thought this was a relatively simple task.
The aim is to create a new workbook, copy the values of two sheets over and then save and close the new workbook.
Why does this code error?
Go to this line Worksheets("Sheet1").Activate
Press F9
Press F5
Check the screen - has the workbook "KPI_Grid.xlsm" been activated ?
Does it actually have a sheet called "Sheet1" ?
If Sheet1 is not in the same workbook as the code then this will naturally error - you need to ensure everything is qualified like this:
ActiveWorkbook.Worksheet("Sheet1").Activate