I am trying to write code in VBA that will copy a range of cells. This I have done successfully but got stuck on the next step. This is the first part:
Range("L1", Range("L1").End(xlDown)).Select
Selection.Copy
Next, I would like the macro to open a new text file (.txt) with the specified name from the excel tab and insert the copied cells.
How do I open a text file?
Thank you
Here is one of many possible references (via Google): http://www.homeandlearn.org/write_to_a_text_file.html
Here is the example they give - you're better reading the article and then adapting to your scenario:
Open FilePath For Output As #2
For i = 1 To LastRow
For j = 1 To LastCol
If j = LastCol Then
CellData = CellData + Trim(ActiveCell(i, j).Value)
Else
CellData = CellData + Trim(ActiveCell(i, j).Value) + ","
End If
Next j
Write #2, CellData
CellData = ""
Next i
With your column L data in the first tab, try:
Sub dural()
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Add
wb1.Activate
Sheets(1).Select
tabname = ActiveSheet.Name
Range("L1", Range("L1").End(xlDown)).Copy
wb2.Activate
ActiveSheet.Paste
wb2.SaveAs Filename:=tabname & ".txt", FileFormat:=xlTextWindows
wb2.Saved = True
wb2.Close
End Sub
Related
I have a master workbook with one sheet that I need to be broken into many workbooks that each have a single worksheet.
These newly created workbooks will be created when rows in the "Master" worksheet have the same content in column B.
I need these workbooks to be saved to the same specific local directory with the file name being the content of column B & ".csv" to make the file a CSV file rather than an XLSX file.
Here is what I have so far (a lot of this came from another upvoted thread on this site with a few tweaks by me).
Sub Splitter()
Dim Master As Workbook
Set Master = Workbooks("Master").Worksheets("Master") 'This declares the target worksheet.
last = 1
For i = 1 To 2000 'This defines the amount of rows
If Range("B" & i) <> Range("B" & (i + 1)) Then
Range("A" & last & ":F" & i).Copy
Set NewBook = Workbooks.Add
NewBook.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
Rows(1).EntireRow.Insert Shift:=xlDown
Range("A1").Value = "Header1"
Range("B1").Value = "Header2"
Range("C1").Value = "Header3"
Range("D1").Value = "Header4"
Range("E1").Value = "Header5"
Range("F1").Value = "Header6"
last = i + 1
Master.Activate
End If
Next i
End Sub
This code will create hundreds, if not thousands, of workbooks with single worksheets from the "Master" Workbook.
I'm having a couple issues here:
This code:
Rows(1).EntireRow.Insert Shift:=xlDown
Range("A1").Value = "Header1"
Range("B1").Value = "Header2"
Range("C1").Value = "Header3"
Range("D1").Value = "Header4"
Range("E1").Value = "Header5"
Range("F1").Value = "Header6"
appears to be adding the header row correctly but it seems to be copying the entire contents of the spreadsheet and pasting it at the next available row. It then overwrites the contents of row 1.
Example: The macro pulls the following rows to a new workbook:
Bat
Bat
Bat
When the above section of code runs, the final product is:
Header
Bat
Bat
Bat
Bat
Bat
It appears to be replicating the content and then pasting over row 1.
The second issue, as alluded to earlier, is that the newly created workbooks/worksheets will not be automatically saved (CSV) and closed, and I will need to go in and close/save them each myself.
They seem to be being created correctly (with the exception of the issue in problem #1). They are simply left open and I need to name and save all of them. Since I am sure there will be a great many of the newly created workbooks, this lack of functionality will make my life very difficult ...
Any help with this would be greatly appreciated. I am fairly new to this, but am picking it up pretty quickly.
My apologies for the long post, I wanted to be as clear as I could as to not waste the readers time.
Because you are still in CopyMode from Range("A" & last & ":F" & i).Copy the .Insert will insert the copied rows again. Therefore put a Application.CutCopyMode = False right before Rows(1).EntireRow.Insert to stop inserting copied rows again.
You need Workbook.SaveAs Method and Workbook.Close Method to save and close the workbooks.
NewBook.SaveAs(FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AccessMode, ConflictResolution, AddToMru, TextCodepage, TextVisualLayout, Local)
NewBook.Close(SaveChanges, Filename, RouteWorkbook)
eg. This should work:
NewBook.SaveAs FileName:="C:\Temp\MyFileName.csv", FileFormat:=xlCSV
NewBook.Close SaveChanges:=False
You should specify any Rows() and Range() with a worksheet like Master.Rows() or NewBook.Worksheets("Sheet1").Range() so that is clear in which workbook\worksheet the range/row is. Then you don't need Master.Activate
What think about this code.
Sub Splitter()
Dim Master As Workbook
Dim n As Integer
Dim strFile As String
Set Master = Workbooks("Master").Worksheets("Master") 'This declares the target worksheet.
last = 1
For i = 1 To 2000 'This defines the amount of rows
If Range("B" & i) <> Range("B" & i + 1) Then
strFile = ThisWorkbook.Path & "\" & Range("b" & i) & ".csv"
TransToCSV strFile, Range("A" & last & ":F" & i)
last = i + 1
End If
Next i
End Sub
Sub TransToCSV(myfile As String, rng As Range)
Dim vDB, vR() As String, vTxt()
Dim i As Long, n As Long, j As Integer
Dim objStream
Dim strTxt As String, strHeader As String
strHeader = "Header1,Header2,Header3,Header4,Header5,Header6" & vbCrLf
Set objStream = CreateObject("ADODB.Stream")
vDB = rng
For i = 1 To UBound(vDB, 1)
n = n + 1
ReDim vR(1 To UBound(vDB, 2))
For j = 1 To UBound(vDB, 2)
vR(j) = vDB(i, j)
Next j
ReDim Preserve vTxt(1 To n)
vTxt(n) = Join(vR, ",")
Next i
strTxt = strHeader & Join(vTxt, vbCrLf)
With objStream
'.Charset = "utf-8"
.Open
.WriteText strTxt
.SaveToFile myfile, 2
.Close
End With
Set objStream = Nothing
End Sub
I'm trying to copy cells(1,1) of excel file 1 to cells(1,1) of excel file 2.
But assuming that I've placed the name of the file I want to open in cells(2,20) and I want to assign variable j = cells(2,20) and use it in a code in copying the file. I seem to be having problems with that.
Here is my code:
Sub Copy_Workbook()
j = Cells(2, 20)
Workbooks.Open ("C:\Users\GNPOWER\Desktop\TRADERS\Jonel\practice\data fetching\" & j & ".xlsx")
Workbooks("Practice_Copy_From.xlsm").Worksheets("Sheet1").Cells(1, 1) = _
Workbooks(" & j & "&.xlsx").Worksheets("Sheet1").Cells(1, 1).Value
End Sub
Am I missing something like a declaration or what?
I'm getting subscript of range 9 when running the program.
You don't have to add an explicit quotation mark in the workbooks name declaration. Also there was an ampersand in front of the extension "&.xlsx" which I removed. Code would be:
Sub Copy_Workbook()
Dim j As String, wb As Workbook
j = Cells(2, 20).Value2
Set wb = Workbooks.Open("C:\Users\GNPOWER\Desktop\TRADERS\Jonel\practice\data fetching\" & j & ".xlsx")
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Value2 = wb.Worksheets("Sheet1").Cells(1, 1).Value2
End Sub
you don't even need to open the "source" file
Option Explicit
Sub Copy_Workbook()
Dim pathName As String, fileName As String
fileName = Cells(2, 20).Value '<--| retrieve the file name from the currently active worksheet cell "A1"
pathName = "C:\Users\GNPOWER\Desktop\TRADERS\Jonel\practice\data fetching\" '<--| set the folder path where "source" workbooks resides
With Workbooks("Practice_Copy_From.xlsm").Worksheets("Sheet1").Cells(1, 1) '<--| reference your "target" cell
.Value = "='" & pathName & "[" & fileName & "]Sheet1'!$A$1" '<--| write a formula that references the proper cell in the proper worksheet of the proper workbook
.Value = .Value '<--| get rid of formula and leave value only
End With
End Sub
What is an efficient way to export a particular range of cells with data from Excel 2010 to CSV using VBA? The data always starts at cell A3. The end of the range depends on the dataset (always column Q but row end may vary). It should only export data from sheet 2 called 'Content' and the cells need to contain only 'real' data like text or numbers, not empty values with formulas.
The reason cells have formulas is because they reference cells from sheet 1 and 3. Formulas use normal reference and also vertical searches.
Using the UsedRange will export all the cells which are used by Excel. This works, but it also ends up exporting all the empty cells containing formulas but no data leading to lots (510 to be precise) of unnecessary semicolons in the output .csv.
Sub SavetoCSV()
Dim Fname As String
Sheets("Content").UsedRange.Select
Selection.Copy
Fname = "C:\Test\test.csv"
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=Fname, _
FileFormat:=xlCSV, CreateBackup:=False, local:=True
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
One solution might be to change the UsedRange in the VB code with Offset or Resize. Another might be to create a RealRange variable and then selectcopy that.
Similar kind of questions have been asked more than once, like here, here and here, and I've also looked at SpecialCells, but somehow I cannot get it to work the way I want it to.
I have tried the below code, but it ends up adding rows from sheet 3 as well.
Sub ExportToCSV()
Dim Fname As String
Dim RealRange As String
Dim Startrow As Integer
Dim Lastrow As Integer
Dim RowNr As Integer
Startrow = 3
RowNr = Worksheets("Content").Cells(1, 1).Value 'this cells has a MAX function returning highest row nr
Lastrow = RowNr + 3
RealRange = "A" & Startrow & ":" & "Q" & Lastrow
Sheets("Content").Range(RealRange).Select
Selection.Copy
Fname = "C:\Test\test.csv"
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:=Fname, _
FileFormat:=xlCSV, CreateBackup:=False, local:=True
Application.DisplayAlerts = False
'ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
If I'm looking in the wrong direction, please refer to other options.
If I understand, you only want to export the cell if it has a value in it. This is going to lead to a csv with different numbers of columns in it. If that's truly what you are trying to do then the fastest way I think is writing your results to a file as below. This ran in about 1 second for 20,000 rows
Dim Lastrow As Integer
Dim RowNr As Integer
Dim SourceSheet As Worksheet
Const Fname As String = "C:\Test\test.csv"
Const StartRow As Integer = 3
Sub ExportToCSV()
On Error GoTo errorhandler
Set SourceSheet = Worksheets("Content")
TargetFileNumber = FreeFile()
Open Fname For Output As #TargetFileNumber 'create the file for writing
Lastrow = SourceSheet.Cells(1, 1).Value + 3 'I would just use the used range to count the rows but whatever
For r = StartRow To Lastrow 'set up two loops to go through the rows column by column
Line = ""
If SourceSheet.Cells(r, 1).Value <> "" Then 'check if there is a value in the cell, if so export whole row
For c = 1 To 17 'Columns A through Q
Line = Line & SourceSheet.Cells(r, c).Value & "," 'build the line
Next c
Line = Left(Line, Len(Line) - 1) 'strip off last comma
Print #TargetFileNumber, Line 'write the line to the file
End If
Next r
GoTo cleanup
errorhandler:
MsgBox Err.Number & " --> " & Err.Description, vbCritical, "There was a problem!"
cleanup:
Close #TargetFileNumber
End Sub
I am relatively new to VBA.
I have a target workbook where the first step is somebody has to write something. If not an error message pops up.
After they filled in their data the code will ask them to open the source workbook(they downloaded the file before). From the source workbook certain columns are read. This all works fine in the code. The problem I have is to get what they filled in the target workbook to be copied down in column (A4:A(last row in source workbook). So the length until where their manually entered data has to be copied down has to be equal to the length of data in the source workbook.
Sub get_rate_codes()
Dim CheckCell As Range
Dim wb_source As Workbook
Dim wb_target As Workbook
Dim strPathName As String
Dim lastRow As Long
For Each CheckCell In Sheets("rate_codes").Range("F3").Cells
If Len(Trim(CheckCell.Value)) = 0 Then
CheckCell.Select
MsgBox "Cell " & CheckCell.Address(0, 0) & " is empty. Please enter SITA."
Exit Sub
End If
Next CheckCell
'start to open file
Application.ScreenUpdating = False
'start is the starting cell while lastRow measures the last data row in the external file
Start = 4
'continue to copy data from the rate codes report
Set wb_target = ActiveWorkbook
With wb_target.Sheets("rate_codes")
lastRow = wb_source.UsedRange.SpecialCells(xlCellTypeLastCell).Row
strPathName = Application.GetOpenFilename()
If strPathName = "False" Then
Exit Sub
End If
Set wb_source = Workbooks.Open(strPathName, 0)
.Range("B" & Start & ":B1000").Value = wb_source.Sheets(1).Range("E2:E1000").Value
.Range("C" & Start & ":C1000").Value = wb_source.Sheets(1).Range("H2:H1000").Value
.Range("D" & Start & ":D1000").Value = wb_source.Sheets(1).Range("G2:G1000").Value
.Range("E" & Start & ":E1000").Value = wb_source.Sheets(1).Range("K2:K1000").Value
.Range("A" & Start & ":A" & lastRow).Value = wb_target.Sheets(2).Range("F2").Value '
wb_source.Close (False)
End With
'close file without saving
Application.ScreenUpdating = True
End Sub
To find the last row you can do this.
Dim lastRow As Long
lastRow = wb_source.Cells(wb_source.Rows.count, "A").End(xlUp).Row
Then you can write to the next line.
.Range("A" & lastRow + 1).Value =
Is there a way to get the contents of a text file and add it to the clip board?
I am thinking along the lines of setting the contents of the DataObject as the contents from a file and then adding the DataObject to the clipboard.
Is this something you can do from Excel VBA?
This is the Code I am using to get the data into a txt file in the correct format. However, I also require it in the clipboard so I can just paste it.
With ws2
Open "C:\Users\peter.carr\Documents\New Action Plan\copytest.txt" For Append As #1
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = lastrow To 2 Step -1
str1 = ""
Print #1, ws2.Cells(i, 1).Value & ") " & ws2.Cells(i, 2).Value
Print #1,
For Each cell In .Range(.Cells(i, 6), .Cells(i, lastcol))
g = i - 1
If cell.Column <> 4 And cell.Column <> 5 And cell.Value <> "" And cell.Value <> "NEW ACTION" Then
Print #1, cell.Value
Print #1, "(" & cell.Offset(-g, 0).Value & ")"
Print #1,
End If
Next cell
Next i
Close #1
End With
I know I could just open the file and copy it. However, the idea is that this is part of a larger process to automate things, hence I really want to be able to fo this without opening the file.
Sub TextToClipboard()
Dim sFile As String: sFile = "C:\Test.txt"
Dim sText As String
Dim Dataobj As DataObject
Set Dataobj = New DataObject
Open sFile For Input As #1
sText = Input(LOF(1), 1)
Dataobj.SetText sText
Dataobj.PutInClipboard
End Sub