after converting my sheet into prn it gives error during upload on my erp ,when i convert prn into txt format i saw some kind of chinese written how to fix this problem. below code add value +1 in row "A" and convert into prn
Sub CONVERT()
Dim vcounter As Long
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate
vcounter = 2
While Range("A" & vcounter).Value <> ""
Range("a" & vcounter).Value = Range("a" & vcounter).Value + 1
vcounter = vcounter + 1
Wend
Application.DisplayAlerts = False
ActiveSheet.SaveAs Filename:="D:\birla soft\" & ActiveSheet.Name & ".prn"
Next ws
End Sub
You're saving a .xlsm/.xlsx file with a .prn extension; that doesn't make it a .prn file, it's still a .xlsm/.xlsx file - the extension isn't what determines the file's format, it's just a convenient indicator for us puny humans to recognize what we're looking at when we browse through files. You want to supply a xlTextPrinter XlFileFormat argument to the SaveAs method:
ActiveSheet.SaveAs Filename:="D:\birla soft\" & ActiveSheet.Name & ".prn", xlTextPrinter
A note about this:
ws.Activate
You don't need it. Instead, qualify these Range calls with the ws object - and you want to iterate the Worksheets collection (Sheets may contain all kinds of non-worksheet sheet types):
For Each ws In ActiveWorkbook.Worksheets ' or did you mean to iterate sheets in ThisWorkbook?
Do While ws.Range(...)
ws.Range(...) = ws.Range(...) + 1
vcounter = vcounter + 1
Loop
Application.DisplayAlerts = False
ws.SaveAs FileName:="..." & ws.Name & ".prn", FileFormat:=xlTextPrinter
Next
Related
I have a code stated below in which i am saving sheet wise file in prn
i do not want to give name to the file when it save ,i just want to save my each sheet by its original name (so , the the sheet name raj,taj,bazz. they all save by its original name.
Sub CONVERT()
Dim vcounter As Long
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate
vcounter = 2
While Range("A" & vcounter).Value <> ""
Range("a" & vcounter).Value = Range("a" & vcounter).Value + 1
vcounter = vcounter + 1
Wend
Application.DisplayAlerts = False
ActiveSheet.SaveAs Filename:="D:\birla soft\apache.prn"
Next ws
End Sub
This code is tested and it save a file with the ActiveSheet name and with the same extension:
ActiveSheet.SaveAs Filename:="D:\birla soft\" & ActiveSheet.Name
If you need to save it with another extension, use this code instead:
ActiveSheet.SaveAs Filename:="D:\birla soft\" & ActiveSheet.Name & ".prn"
In your code, if you need to save each sheet with its name, just change ActiveSheet with your ws variable, like this:
Sub CONVERT()
Dim vcounter As Long
Dim ws As Worksheet
For Each ws In Sheets
ws.Activate
vcounter = 2
While Range("A" & vcounter).Value <> ""
Range("a" & vcounter).Value = Range("a" & vcounter).Value + 1
vcounter = vcounter + 1
Wend
Application.DisplayAlerts = False
ws.SaveAs Filename:="D:\birla soft\" & ws.Name & ".prn"
Next ws
End Sub
I have a macro code to open several excel sheets one after the other (I only show 3 here):
Sub Macro1()
Workbooks.Open Filename:=Range("F19").Value, UpdateLinks:=0
ActiveWindow.Visible = True
Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
Workbooks.Open Filename:=Range("F21").Value, UpdateLinks:=0
ActiveWindow.Visible = True
Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
Workbooks.Open Filename:=Range("F23").Value, UpdateLinks:=0
ActiveWindow.Visible = True
Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
End Sub
The 'Range' shows the cell with the specific file path.
Currently, if the macro does not find one of the files, it produces an error and the process is forced to stop. Is it possible to include an additional line code that if the file is not found in the specified path, then the process continues and does not stop (no debugging)?
This may helps:
Option Explicit
Sub Macro1()
Dim LastRow As Long, i As Long
Dim PathName As String, MissingFiles As String
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 19 To LastRow Step 2 '<- Start from 19 like the example and stop lastrow column A sheet 1. Loop every two.
PathName = .Range("A" & i).Value
If Len(Dir(PathName)) = 0 Then '<- Make sure you add the extension of the file.
If MissingFiles = "" Then
MissingFiles = PathName
Else
MissingFiles = MissingFiles & vbNewLine & PathName
End If
Else
Workbooks.Open Filename:=PathName, UpdateLinks:=0
ActiveWindow.Visible = True
' Windows("Data Quality Checks - ITS v2.8.xlsm").Activate
End If
Next i
MsgBox "Missing Files are: " & vbNewLine & MissingFiles
End With
End Sub
Sheet Structure:
Message Box :
I am trying to write a Macro in VBA using Excel 2010 that is linked to a button in a worksheet (located in Cell A1). When the button is pressed, a CSV should be generated that deletes columns A and B, so that column C effectively becomes column A. I am trying to also name the newly generated CSV based on the cell contents from cell A30 within the worksheet, but when I run the macro I am getting an error on the SaveAs function. I believe this is because cell A30 is deleted later on in the script. My question is where there is a way to use the Range (A30) to name the new CSV while still deleting that cell later on within the new CSV all within the same sub? I'm still new to VBA, so it is unclear to me why this is an issue when I would think that each command is executed sequentially, so once the CSV is saved with the new name, I would think I'd be able to delete the source of the file name.
Sub rpSaveCSV()
Dim ws As Worksheet
Set ws = ActiveSheet
'Saves current sheet of tracker as a CSV
ws.SaveAs "Y:\Drive\Youth " & Range("A30") & " .csv", FileFormat:=xlCSV
'Copies entire sheet and pastes values to get rid of formulas
ws.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Select
Application.CutCopyMode = False
'Deletes first two columns and all remaining columns without content
Range("A:B").EntireColumn.Delete
Range("BI:XFD").EntireColumn.Delete
'Saves panel CSV
ActiveWorkbook.Save
'Opens Tracker up again
Workbooks.Open Filename:="Y:\Drive\Tracker.xlsm"
End Sub
Declare a variable to hold the string value:
Dim filename as String
filename = Range("A30")
'verify that "Y:\Drive\Youth " & filename & " .csv" is a valid file name:
Debug.Print "Y:\Drive\Youth " & filename & " .csv" ' looks right? Ctrl+G to find out
ws.SaveAs "Y:\Drive\Youth " & filename & " .csv", FileFormat:=xlCSV
'...delete columns...
'...do stuff...
Debug.Print filename 'value is still here!
I would recommend learning to use arrays with Excel data. It can often be far simpler than trying to replication Excel Application functions in VBA. And it is far more efficient/fast.
Here is a function that feeds the data to an array, and then prints the array to a csv (text) file.
Sub CreateCsvFromWorkSheet(leftColumn, rightColumn, FileName)
Set ws = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(FileName, True)
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
ar = ws.Range(ws.Cells(1, leftColumn), ws.Cells(lastRow, rightColumn))
For i = 1 To UBound(ar, 1)
strLine = ""
For j = 1 To UBound(ar, 2)
strLine = strLine & ar(i, j) & ","
Next
strLine = Left(strLine, Len(strLine) - 1)
f.WriteLine strLine
Next
f.Close
End Sub
You can call the function like this:
Sub TestRun()
FileName = "Y:\Drive\Youth " & Range("A30") & " .csv"
CreateCsvFromWorkSheet 3, 60, FileName
MsgBox "Complete."
End Sub
I have some folders with hundreds of reports - all reports are the same, and there´s nothing else in that folders.
I should take multiple workbooks like the first one in the image, and recopilate them in a master file (second image).
I have some code - below - but I don´t know how to complete it; The workbook is a template, so it always have 15 rows (could be completed or not) and I need to bring all that´s there plus the date and group control, which is shared by every document inside the file.
I´d appreciate if you could help me complete the code; somebody told me this could be done using powerquery but I´ve never used it. If you think this would be easier, please let me know your thoughts.
Thanks!!
What I have:
Public Sub test()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Path = "C:\Users\Maudibe\Desktop\ExcelFiles\"
Filename = Dir(Path & "*.xlsm")
'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
'
' **WHAT TO DO HERE?**
'
MsgBox Filename & " has opened"
wbk.Close True
Filename = Dir
Loop
End Sub
So i modified your code to this: (Has to be in ThisWorkbook)
Public Sub test()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim sht, msht As Worksheet
Dim lRowFile, lRowMaster As Long
Dim FirstDataSet As Integer
Path = "C:\Users\User\Desktop\Files\"
Filename = Dir(Path & "*.xlsm")
'--------------------------------------------
'OPEN EXCEL FILES
Do While Filename <> "" And Filename <> "Master.xlsm" 'Dont Open MasterFile 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
Set sht = Workbooks(Filename).Worksheets(1) 'First Sheet in File
Set msht = ThisWorkbook.Worksheets(1) 'First Sheet in Master
lRF = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 'Last Row in File
lRM = msht.Cells(Rows.Count, 1).End(xlUp).Row 'Last Row in Master
FirstDataSet = 5 'First Data Set in File
For i = FirstDataSet To lRF
lRM = msht.Cells(Rows.Count, 1).End(xlUp).Row 'Last Row in Master
msht.Range("A" & lRM + 1).Value = sht.Range("A" & i).Value 'DocumentName
msht.Range("B" & lRM + 1).Value = sht.Range("B" & i).Value 'Amount
msht.Range("C" & lRM + 1).Value = sht.Range("D2").Value 'Date
msht.Range("D" & lRM + 1).Value = sht.Range("D3").Value 'Group #
Next i
wbk.Close True
Filename = Dir
Loop
End Sub
It will open the workbooks and check which rows are filled in Col A (Non used have to be blank). Then it copies the Data to the Master File. My Workbooks that have been opened looked like this and the Result:
I have 50 excel workbooks each containing 5 sheets inside. They all have the same structure, same sheet names, same column titles. I need to extract the 4th sheet from each file and put data in one single sheeted workbook under each other. I found this macro but it extracts on different sheets. I can't figure out how to modify this code to fit my needs. Can someone please advise?
Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No file is chosen"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open Filename:=FilesToOpen(x)
Sheets("Associates report").Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub code here
Here's a macro for collecting data from all files in a specific folder.
Workbooks to 1 Sheet
The parts of the code that need to be edited are colored to draw your attention.
In the "this is the section to customize", the code:
LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
...would need to be something like this to copy from sheet 4:
LR = Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Sheets("Sheet4").Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
Or looking at your sample code above, maybe:
LR = Sheets("Associates Report").Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Sheets("Associates Report").Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
It's intended as a generic starting point, you will have to go through and edit for your environment. Check the comments.