Im using the following code, but when I run it, it only saves the last part (& Day(Now) & "-" & Month(Now) & "-" & Year(Now)) of the name. Is not taking into consideration de string "Asesor". I don't know what part I'm missing:
Sub SaveFile()
Dim Asesor As String
Asesor = Range("B3").Value
Dim DestFile
DestFile = "C:\Users\ST\"
Application.ScreenUpdating = False
Workbooks("Grillas_QA.xlsm").Activate
ActiveSheet.Range("A1:K51").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
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
Application.DisplayAlerts = False
Here's where I save the file.
ActiveWorkbook.SaveAs Filename:=DestFile & Asesor & " " & Day(Now) & "-" & Month(Now) & "-" & Year(Now), _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Thnx in advance for the help.
As follow up from comments, next line
Asesor = Range("B3").Value
should be changed to something like this:
Asesor = ThisWorkbook.Worksheets("Sheet1").Range("B3").Value
Also as a recommendation, I suggest you to read this post: How to avoid using Select/Active statements
Related
I have a weird problem.
I have a piece of VBA code that works perfectly fine. Many of my colleagues use it to create CSV files without problems.
Sub CSV_Tagetik()
Dim newWorkbook As Workbook
Dim vWorksheet As Worksheet
Dim vWorkbook As String
Dim vEntity
Dim vDate As String
vWorkbook = ActiveWorkbook.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'--------------TGK------------
vEntity = Worksheets("Control").Cells(6, 3)
vRange = Worksheets("Control").Cells(1, 18)
vDate = Worksheets("Control").Cells(4, 3)
Sheets("Journaalpost").Visible = True
Sheets("Journaalpost").Select
ActiveSheet.Range(vRange).AutoFilter Field:=13, Criteria1:="<>0", _
Operator:=xlAnd
Range(vRange).Select
Selection.Copy
Set newWorkbook = Workbooks.Add
newWorkbook.Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
newWorkbook.Sheets(1).Name = vEntity
newWorkbook.SaveAs Filename:=Workbooks(vWorkbook).Path & "\" & vEntity & " Aansluiting Tagetik " & vDate, FileFormat:=xlCSV, _
CreateBackup:=False
newWorkbook.Close
Sheets("Journaalpost").Visible = False
Sheets("Control").Select
Finally:
Application.CutCopyMode = False
Exit Sub
End Sub
But now there is a new colleague for whom the save command
newWorkbook.SaveAs Filename:=Workbooks(vWorkbook).Path & "\" & vEntity & " Aansluiting Tagetik " & vDate, FileFormat:=xlCSV, _
CreateBackup:=False
prompts an error:
Run-time error '1004':
Method 'SaveAs' of object '_Worksheet' failed
I have no idea why. I cannot recreate it in my environment, because for me it works perfectly.
What steps could I take to fix this?
Thank you!
I have a problem. I have data in this format:
13.3.19 00:23:01
I use a macro to import it to one tab, copy it to another tab, and replace the "." with "/" so it in the correct format. But excel said no and interprets most of the data as text, which is not a problem, I just use datevalue on that. But when it comes to this date in particular:
12.3.19 23:52:41
Excel is interpreting it as a date in the US format and instead of leaving it as march the 12th, it makes December the 3rd out of it. This renders the datevalue useless in just a part of my data set.
Any thoughts?
Code of the macro here:
Sub import_data()
Path = Worksheets("Macro").Cells(6, 4).Value
Analysis = ThisWorkbook.Name
Rfrom = Sheets("Macro").Cells(8, 4)
Rto = Sheets("Macro").Cells(9, 4)
Application.DisplayAlerts = False
For Data_Range = Rfrom To Rto
Fname = Sheets("Macro").Cells(Data_Range, 3)
Segment_name = Sheets("Macro").Cells(Data_Range, 4)
'selecting workbook
Workbooks.Open Filename:= _
Path & "\" & Fname _
Sheets(Segment_name).Select
Range("A2:W14000").Select
Selection.Copy
Windows(Analysis).Activate
Sheets("Raw_data_import").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Fname).Activate
ActiveWindow.Close
Windows(Analysis).Activate
Next Data_Range
Windows(ThisWorkbook.Name).Activate
Sheets("Raw_data_import").Activate
Range("E:G").Select
Selection.Copy
Sheets("Priprava_dat").Select
Range("A:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Priprava_dat").Range("A:B").Replace ".", "/"
Dim lastRow As Long
lastRow = Range("C" & Rows.Count).End(xlUp).Row
Range("D2").AutoFill Destination:=Range("D2:D" & lastRow)
Range("E2").AutoFill Destination:=Range("E2:E" & lastRow)
Range("F2").AutoFill Destination:=Range("F2:F" & lastRow)
Range("G2").AutoFill Destination:=Range("G2:G" & lastRow)
Range("H2").AutoFill Destination:=Range("H2:H" & lastRow)
Range("I2").AutoFill Destination:=Range("I2:I" & lastRow)
Range("J2").AutoFill Destination:=Range("J2:J" & lastRow)
Windows(ThisWorkbook.Name).Activate
Sheets("Macro").Activate
End Sub
you can set the number format of the cells using
Sheets("Priprava_dat").Range("A:B").NumberFormat = "dd/mm/yy hh:mm:ss"
just before changing the '.' to '/' using
Sheets("Priprava_dat").Range("A:B").Replace ".", "/"
Sub vova()
Dim S_path As String
Dim S_name1 As String, S_nameW1 As String
S_path = "S:\"
S_path = Trim(S_path) + Trim(Worksheets("1").Range("G6").Value) + ".xlsx"
Range("A1:N27").Select
Selection.Copy
Workbooks.Add
S_nameW1 = ActiveWorkbook.name
S_name1 = ActiveSheet.name
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("A:A").ColumnWidth = 2
Columns("B:B").ColumnWidth = 10
Columns("C:C").ColumnWidth = 35
Columns("D:D").ColumnWidth = 13
Columns("M:M").ColumnWidth = 15
Columns("N:N").ColumnWidth = 15
Application.CutCopyMode = False
ActiveWorkbook.SaveAs FileName:=S_path, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub
Can someone help me, need the macro to delete blank raws(if 1-5 is filled) then 6-15 is deleted and macro creates new workbook with needed raws
created workbook should look like this
You could do something like that:
Columns("N:N").ColumnWidth = 15
Application.CutCopyMode = False
With S_name1
for i = .range("A1048576").end(xlup).row to 9 Step -1
if .cells(i, 2) = "" Then
.rows(i & ":" & i).delete
End if
Next
End With
ActiveWorkbook.SaveAs FileName:=S_path, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
This will basically loop backward from the last used cell in column A till row 9, and delete the row if there is nothing in column B (which appears to be the case in your screenshot).
This sub is set up to copy info over from one worksheet and paste the values into a new CSV workbook. I keep getting a runtime error on the pastespecial, however, it's only on the first click after opening the spreadsheet, if I click it again it works perfectly. And even though it gives me an error, when i click end it still pastes the values over.
Sub export_save()
Dim nrows As Integer
Dim norders As Integer
Dim i As String
Dim cell As Range
Dim fname As String
Dim WS As Worksheet
Dim WK As Workbook
Set WK = Workbooks.Add
Dim k As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
k = 2
i = "DO" 'plant to plant movement
'name new file
On Error GoTo canceled
fname = InputBox("Please name the new file, exlude any filename extensions.", "Export Data")
WK.SaveAs Filename:="S:\Active Customers\Teknor Apex\Feeds\Orders\" & fname, _
FileFormat:=xlCSV
MsgBox ("File saved to file path:S:\Active Customers\Teknor Apex\Feeds\dev\" & fname)
'copy info over
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Activate
nrows = Rows(Rows.Count).End(xlUp).Row
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Range("A3:AG" & nrows).copy
WK.Activate
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'remove parentheses
norders = Rows(Rows.Count).End(xlUp).Row
Range("AI2").FormulaR1C1 = "=MID(RC[-14],FIND(""("",RC[-14],1)+1,3)"
Range("AI2").AutoFill Destination:=Range("AI2:AI" & norders), Type:=xlFillDefault
Range("AI2:AI" & norders).copy
Range("U2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("AI:AI").Delete Shift:=xlToLeft
'remove ship paratheses in DO orders
For Each cell In Range("B2:B" & norders)
If cell.Value = i Then
Range("AI" & k).FormulaR1C1 = "=MID(RC[-13],FIND("" ("",RC[-13],1)+1,3)"
Range("AI" & k).copy
Range("V" & k).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
k = k + 1
Next cell
'delete extra column used to remove paratheses
Columns("AI:AI").Delete Shift:=xlToLeft
WK.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
canceled:
End Sub
For clarity's sake here is a smaller version containing only the error, which is in the pastespecial line.
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Activate
nrows = Rows(Rows.Count).End(xlUp).Row
Workbooks("Teknor Template dev").Worksheets("REFORMATTED").Range("A3:AG" & nrows).copy
WK.Activate
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Change:
Range("A1:AG" & nrows).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
To:
Range("A1:AG" & nrows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Your code is missing Paste:=
I need to copy two seperate colums of data from one workbook to another.
Here is my code:
Workbooks.Open Filename:=file & "\GSP - " & months(numMonth) & " 1-" & numdays (numMonth) & " " & tYear & " - Prem.xls", _
Origin:=xlWindows, UpdateLinks:=False, ReadOnly:=True
ActiveWorkbook.Sheets(tDay).Activate
range("AA6:AA40").Select
Selection.Copy
Windows(fileM & ".xls").Activate
Sheets("Summary").Activate
range("C3:C37").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Close
ActiveWindow.Close
Workbooks.Open Filename:=file & "\GSP - " & months(numMonth) & " 1-" & numdays(numMonth) & " " & tYear & " - Prem.xls", _
Origin:=xlWindows, UpdateLinks:=False, ReadOnly:=True
ActiveWorkbook.Sheets(tDay).Activate
range("AA84:AA118").Select
Selection.Copy
Windows(fileM & ".xls").Activate
Sheets("Summary").Activate
range("H3:H37").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Close
ActiveWindow.Close
When the macro finishes running, the second copy is not completed and I am left with Error 9 at the break on the second Windows(fileM & ".xls").Activate'
I see a lot of problems with this code. As has been mentioned, you are not defining tDay. I assume this is being defined elsewhere, else you wouldn't be getting as far as you are.
Using ActiveWorkbook should be avoided whenever possible, since it may not always be the workbook that you expect. Much better to create a Workbook variable and assign it to the selected workbook; then use it instead. I suspect this is the cause of your problem -- ActiveWorkbook.Close isn't closing the one you expect.
Next, you are opening the file, copying from it, closing it, and repeating. Why not leave it open?
Next, you don't always need to call .Select in order to take action on a range. You can call .Copy and .PasteSpecial directly from the Range object.
I'm making some assumptions about your intent, but the following code incorporates the suggestions above.
Sub foo()
Dim wkbGSP As Workbook
Dim wkbFileM As Workbook
tday = "sheet1"
Set wkbFileM = Workbooks(fileM & ".xls")
Workbooks.Open Filename:=file & "\GSP - " & months(numMonth) & " 1-" & numdays (numMonth) & " " & tYear & " - Prem.xls", _
Origin:=xlWindows, UpdateLinks:=False, ReadOnly:=True
Set wkbGSP = ActiveWorkbook
wkbGSP.Sheets(tday).Range("AA6:AA40").Copy
wkbFileM.Sheets("Summary").Activate
Range("C3:C37").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wkbGSP.Sheets(tday).Activate
Range("AA84:AA118").Copy
wkbFileM.Sheets("Summary").Activate
Range("H3:H37").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wkbGSP.Close
End Sub
Guessing your tDay value is not found such as out of range or no such sheet number. How do you define this value?