vba: copy sheet with named destination - excel

I want to create a copy of a sheet with data.
I managed to create a copy with this code, but want to create it with a defined name
Dim outsheet As String
outsheet = "SAP Import"
Dim wsCopy As Worksheet
Set wsCopy = ThisWorkbook.Worksheets(outsheet)
wsCopy.Copy After:=ThisWorkbook.Worksheets(outsheet)
Now I would like to change the name. The obvious solution is however not implemented in VBA (Parameter unknown)
Dim strSheetTemp As String
strSheetTemp = outsheet + "-temp"
wsCopy.Copy Destination:=ThisWorkbook.Worksheets(strSheetTemp)
How can I create a named copy?
Or how can I get the name of the copy to rename it ?

I believe the sheet can only be named (or renamed in this case) after being copied.
Dim outsheet As String
outsheet = "SAP Import"
Sheets(outsheet).Copy After:=Sheets(outsheet)
Sheets(Sheets(outsheet).Index + 1).Name = outsheet & "-temp"

Try this one:
Dim outsheet As String
outsheet = "SAP Import"
Dim wsCopy As Worksheet
Set wsCopy = ThisWorkbook.Worksheets(outsheet)
wsCopy.Copy After:=wsCopy
ActiveSheet.Name = outsheet & "-temp"
Following your trial philosophy...
In order to change the name you should use the property .Name.
That one will work in your case.
Hope it helps

Related

VBA Using a variable to select a worksheet

I'm attempting to code a system where I Select data from a set of worksheets whose titles are generated by the user. The Titles of the created sheets are then stored as strings. Is there a way to open/refer to a worksheet using these strings?
My code is as below
Dim Title As String
Dim Sheet_title As Worksheet
Sheets("Config").Select
Sheets("config").range("C25").Select
Title = ActiveCell.Value
Debug.Print Title
Sheet_title = Title
Sheets("Results").range("B7") = Sheets(title).range("E8")
The "sheets(Title)" fails, as well as my attempt to fix it by setting Sheet_Title = Title (Object variable not set - Error 91).
Is there any way to select a worksheet using a string variable?
Referencing Objects (Set)
A Quick Fix
To reference a worksheet (any object), you need to use the Set keyword:
Set Sheet_title = Sheets(Title)
Sheets("Results").Range("B7").Value = Sheet_title.Range("E8").Value
A Recommendation
Option Explicit
Sub Test()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim wsCon As Worksheet: Set wsCon = wb.Sheets("Config")
Dim Title As String: Title = wsCon.Range("C25").Value
Debug.Print Title
Dim wsTit As Worksheet: Set wsTit = wb.Sheets(Title)
Dim wsRes As Worksheet: Set wsRes = wb.Sheets("Results")
wsRes.Range("B7").Value = wsTit.Range("E8").Value
End Sub

copy data between 2 partially matched worksheets(in different workbooks) in vba

i have 2 workbooks 1.remediation.xlsm 2.int_calculation.xlsx
on both workbooks some new worksheets are created dynamically when everytime I run a macro.
here I have added one new worksheet "123456" on remediation.xlsm file and another one called
"Corrected_Accruals-123456" on int_calculation.xlsx file.
i need a piece of code which will take values from a range and search that in both workbooks , if there is a match it will copy data from 123456 and paste it on Corrected_Accruals-123456.
attaching my code for this one, I'm getting error-6 "overflow when running this on.
drive link for 2 workbooks
Sub Copy_Data()
Dim lastRow As Long
Dim offsetRow As Long
Dim i As Range
Dim opsheet As Worksheet
Dim inputsheet As Worksheet
Dim ip As Worksheet
Set inputsheet = Workbooks("remediation.xlsm").Worksheets("reference")
inputsheet.Activate
lastRow = inputsheet.Columns("A").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For Each i In inputsheet.Range("A2: A" & lastRow)
Set opsheet = Workbooks("int_Calculation.xlsx").Worksheets("Corrected Accruals" & "-" & i.Value)
Set ip = Workbooks("remediation.xlsm").Worksheets(i.Value)
opsheet.Cells("A5") = ip.Cells("A5")
opsheet.Cells("B5") = ip.Cells("B5")
opsheet.Cells("D5") = ip.Cells("D5")
opsheet.Cells("E5") = ip.Cells("E5")
Next i
End Sub

VBA-Excel 2010 Macro Error "memeber or data method not found"

I know this is a super generic error but I am new to VBA / Macros and cant get past this.
I have an and excel workbook that has data I need to copy to another excel workbook.
The excel workbook that the data is copied to is on a network share and will be written to frequently.
here is my macro code:
Sub export()
Dim exportFile As String
Dim importSheet As String
Dim rowData As String
exportFile = "\\<server>\spd\_Spec_ParaData\data_import.xlsx"
importSheet = "OutPutValues"
importRange = "A2:ZZ2"
' Get the row from the workbook that we are running in
rowData = Workbooks().Worksheets(importSheet).Range(importRange)
' Not sure if this will work, or always overwrite the last row. May need to be .Row+1
newRow = Workbooks(exportFile).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
exportRange = "A" & (newRow + 1) & ":ZZ" & (newRow + 1)
' Assuming Workbooks() gets the current workbook.
Workbooks(exportFile).Sheets(exportSheet).Range(exportRange) = Workbooks().Sheets(importSheet).Range(importRange)
End Sub
My error is poping up on the rowData=Workbooks(exportFile).Worksheets
Can someone help me figure out what I am doing wrong?
Thank you,
Jennifer
Try your code with the following modifications, I'm just opening the workbook and referencing the worksheet (I guess the problem is that). I'm closing the workbook straight after.
Sub export()
Dim exportFile As String
Dim importSheet As String
Dim rowData As String
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
exportFile = "\\<server>\spd\_Spec_ParaData\data_import.xlsx"
importSheet = "OutPutValues"
importRange = "A2:ZZ2"
'Open your workbook and point to your spreadsheet
Set wb = Workbooks.Open(exportFile)
Set ws1 = wb.Sheets(importSheet)
' Get the row from the workbook that we are running in
rowData = wb.ws.Range(importRange)
' Not sure if this will work, or always overwrite the last row. May need to be .Row+1
newRow = wb.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
exportRange = "A" & (newRow + 1) & ":ZZ" & (newRow + 1)
'NOTE: consider definying the variable "exportSheet", I will do it just for example purpose
Dim exportSheet As String: exportSheet = "InputValues"
Set ws2 = wb.Sheets(exportSheet)
' Assuming Workbooks() gets the current workbook.
wb.ws2.Range(exportRange) = wb.ws1.Range(importRange)
wb.Close
End Sub

Copy used range to text file

I want to:
Copy the used range of a sheet called "Kommentar"
Create a ".txt" file ("Kommentar.txt") in the same directory as ThisWorkbook
Paste the previously copied used range
Save the ".txt" file
I have:
Sub CreateAfile()
Dim pth As String
pth = ThisWorkbook.path
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim a As Object
Set a = fs.CreateTextFile(pth & "\Kommentar.txt", True)
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Kommentar")
Dim rng As Range
Set rng = sh.UsedRange
a.WriteLine (rng)
a.Close
End Sub
I get
run-time error '13' Mismatch
In line a.WriteLine (rng) the function doesn't accept range to be written.
Since your range is probably made up of several cells, you have to loop through them to get all the text into a string variable. If you use a Variant variable you can copy the values and automatically get an array with the correct dimensions of all the data in the cells, then loop it and copy the text:
Function GetTextFromRangeText(ByVal poRange As Range) As String
Dim vRange As Variant
Dim sRet As String
Dim i As Integer
Dim j As Integer
If Not poRange Is Nothing Then
vRange = poRange
For i = LBound(vRange) To UBound(vRange)
For j = LBound(vRange, 2) To UBound(vRange, 2)
sRet = sRet & vRange(i, j)
Next j
sRet = sRet & vbCrLf
Next i
End If
GetTextFromRangeText = sRet
End Function
Call the function in your code by replacing the a.WriteLine (rng) line with the following:
Dim sRange As String
sRange = GetTextFromRangeText(rng)
Call a.WriteLine(sRange)
Not sure you can do that. I believe you would have to write it out line by line.
Here is an alternative option.
Rather than use the FSO, you could just try saving the sheet as a .txt file.
Here's some sample code.
Credit should goto http://goo.gl/mEHVx
Option Explicit
'Copy the contents of a worksheet, and save it as a new workbook as a .txt file
Sub Kommentar_Tab()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wbDest As Workbook
Dim fName As String
'References
Set wbSource = ActiveWorkbook
Set wsSource = ThisWorkbook.Sheets("Kommentar")
Set wbDest = Workbooks.Add
'Copy range on original sheet
'Using usedrange can be risky and may return the wrong result.
wsSource.UsedRange.Copy
'Save in new workbook
wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
'Get file name and location
fName = ThisWorkbook.Path & "\Kommentar.txt"
'Save new tab delimited file
wbDest.SaveAs fName, xlText
wbDest.Close SaveChanges:=True
End Sub
Let's say yourRange is the range you want to copy as string.
Use yourRange. Copy to copy it.
After you copied it, Excel saves the text value to the clipboard. Cells in a row separated by tabs, and every row ends with an enter. You can use DataObject's GetFromClipboard and GetText method to save it to a string variable.
Use CreateTextFile to save it to a file.
#xwhitelight gives a good outline. Thanks. But I needed to supply details to myself to accomplish my own task and thought I'd share.
First, a Reference to Microsoft Scripting Runtime and another to Microsoft Forms 2.0 Object Library are required.
The coding details I added to produce an output file follow.
Note that textfilename is the fully-qualified name of the output file that contains the spreadsheet range.
Note that textfilename is opened in the last line of the sub, which isn't necessary, but it's reassuring to SEE what the file contains. Of course, the MsgBox is also unnecessary.
Sub turnRangeIntoTextFile(rg As Range, textfilename As String)
Dim textFile as TextStream
Dim fs As FileSystemObject
Dim myData As DataObject
Set myData = New DataObject
Set fs = CreateObject("Scripting.FileSystemObject")
rg.Copy
myData.GetFromClipboard
MsgBox myData.GetText ' reassurance (see what I got)
Set textFile = fs.CreateTextFile(textfilename, True)
textFile.WriteLine (myData.GetText)
textFile.Close
CreateObject("Shell.Application").Open (textfilename)
End Sub

Copying specific columns from several workbooks to one master workbook, without constantly editing code

I am trying to read a specific set of columns from a workbook (every week it is a new workbook) and copy them into another workbook. This I have been able to do, but I think there is a cleaner way to do it!! My code is very bulky and problematic, as every week I need to read info from a different workbook so I have to go back into the code and change the workbook file name. I would love any input on how to improve the code and speed up changing the file name for the workbook from which columns are copied....for example is it possible to ask the user to input the file name in place of a static name??
Any feedback / suggestions are greatly appreciated!!! My code is below:
Sub CopyColumnToWorkbook()
Dim sourceColumns As Range, targetColumns As Range
Dim qw As Range, rw As Range
Dim sd As Range, fd As Range
Dim bu As Range, hu As Range
Dim zx As Range, gx As Range
Dim op As Range, wp As Range
Dim ty As Range, ly As Range
Set sourceColumns = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("L")
Set targetColumns = Workbooks("LU.xls").Worksheets(1).Columns("A")
Set qw = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("G")
Set rw = Workbooks("LU.xls").Worksheets(1).Columns("B")
Set sd = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("C")
Set fd = Workbooks("LU.xls").Worksheets(1).Columns("C")
Set bu = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("N")
Set hu = Workbooks("LU.xls").Worksheets(1).Columns("D")
Set zx = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("R")
Set gx = Workbooks("LU.xls").Worksheets(1).Columns("E")
Set op = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("S")
Set wp = Workbooks("LU.xls").Worksheets(1).Columns("F")
Set ty = Workbooks("WERT_2013_01_24.xlsx").Worksheets(1).Columns("I")
Set ly = Workbooks("LU.xls").Worksheets(1).Columns("G")
sourceColumns.Copy Destination:=targetColumns
qw.Copy Destination:=rw
sd.Copy Destination:=fd
bu.Copy Destination:=hu
zx.Copy Destination:=gx
op.Copy Destination:=wp
ty.Copy Destination:=ly
End Sub
A simple way to neatly take user input is to use the InputBox function
Sub ReadInputBox()
Dim readWorkbookLocation As String
readWorkbookLocation = InputBox("What is the name of the workbook you wish to read from?", "Workbook Select")
MsgBox workbookFile
End Sub
Yup. You can use the Application.GetOpenFilename to let the user choose the file name. For example
Option Explicit
Sub Sample()
Dim Ret
Dim Wb As Workbook
Dim ws As Worksheet
Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If Ret <> False Then
Set Wb = Workbooks.Open(Ret)
Set ws = Wb.Sheets("Sheet1")
With ws
'
'~~> Do whatever you want to do here with the worksheet
'
End With
End If
End Sub
EDIT: I just noticed that You have tagged it as excel-vba-mac as well. If you are doing this on Excel 2011 then see this link which shows how to use the Application.GetOpenFilename. The rest of the code remains as it is.
For these type of operations, I use a separate Excel file that contains the vb codes. (I'll call this file "Operation"). On a worksheet put the name of the source/destination file. Add buttons such as "Select Source", "Select Destination", which would prompt for a file but put the selected filename on the sheet only. Another button "Go" will do the actual operation using the files specified, something like:
If the columns to be copied seldom change, you can leave it inside VBA. If it changes from time to time or you need several versions, put it on the Operation worksheet too. If you need a more complex scenario, you can put the configuration on another worksheet in the sources/destination workbooks, so authors can specify the columns themselves.
As a suggestion for your code, use constants/variable for the filenames, to minimize typing when changing filenames manually. Also assign to variables the Workbook and Worksheet being operated on.
' OPERATIONS SHEET
Dim operWB as Workbook
Dim operWS as Worksheet
Set operWB = Application.ActiveWorkbook
Set operWS = operWB.ActiveSheet
' SOURCE
Dim srcFN as string
' HARDCODED: same as before
'srcFN = "WERT_2013_01_24.xlsx"
' OR get from Cell C2
srcFN = operWS.Cell( 2, 3 )
Dim srcWB as Workbook
Dim srcWS as Worksheet
Set srcWB = Workbooks.Open( srcFN )
Set srcWS = srcWB.Worksheets( 0 )
' DESTINATION
.... do the same ...
.... OPTION 1: COPY ....
Set srcRange = srcWS.Columns( "L" ) ' <-- or get from B10
Set dstRange = dstWS.Columns( "A" ) ' <-- or get from C10
srcRange.Copy Destination:=dstRange
....
.... OPTION 2: COPY AS LOOP ....
Dim currentRow As Integer
currentRow = 10
' keep going while B10, B11... is not empty
While operWS.Cells(currentRow, 2) <> ""
Set srcRange = srcWS.Columns( operWS.Cells(currentRow, 2) ) ' B10, B11 ...
Set dstRange = dstWS.Columns( operWS.Cells(currentRow, 3) ) ' C10, C11 ...
srcRange.Copy Destination:=dstRange
currentRow = currentRow + 1
Wend
You may use the following simple code to loop over all the files in the folder without knowing their names and quantity:
LoopFileNameExt = Dir(InputFolder & "*.xls?")
Do While LoopFileNameExt <> ""
'your code here
LoopFileNameExt = Dir
Loop
Wildcards are allowed in filemask. Good luck!

Resources