I have an issue runtime error 1004 with the below code, could anyone clarify for me what could be driving this?
Sub Excel1()
Dim rngLoopRange As Range
Dim wsSummary As Worksheet
Dim rngDealers As Worksheet
Set wsSummary = Sheets("PL")
For Each rngLoopRange In Worksheets("AUX").Range("A1:A38")
wsSummary.Range("C12").Value = rngLoopRange.Value
Application.Run "TM1REFRESH"
Dim wb As Workbook
Set wb = Workbooks.Add
ActiveWorkbook.SaveAs filename:=ThisWorkbook.Path & "\" & Range("C12").Value
ws.Copy before = wb.Worksheets(1)
Next rngLoopRange
Set wsSummary = Nothing
MsgBox "Complete!", vbInformation
End Sub
The above is now saving the file using the name I wanted, can you please advise now why it is giving me an
error '424'
on the sheet copying over. with the code line ws.Copy before = wb.Worksheets(1)
Sub Excel1()
Dim rngLoopRange As Range
Dim wsSummary As Worksheet
Dim rngDealers As Worksheet
Set wsSummary = Sheets("PL")
For Each rngLoopRange In Worksheets("AUX").Range("A1:A38")
wsSummary.Range("C12").Value = rngLoopRange.Value
Application.Run "TM1REFRESH"
Dim wb As Workbook
Set wb = Workbooks.Add
ActiveWorkbook.SaveAs filename:=ThisWorkbook.Path & "\" & wsSummary.Range("C12").Value
ws.Copy before:=wb.Worksheets(1)
wb.Close savechanges:=True
Next rngLoopRange
Set wsSummary = Nothing
MsgBox "Complete!", vbInformation
End Sub
Related
I have a macro that works
Sub EXPORT_POR()
Dim wb As Workbook
Dim ws As Worksheet
Dim FileSaveName As Variant
FileSaveName = Application.GetSaveAsFilename(fileFilter:="Text (Tab delimited) (*.*), *.*")
Sheets("POR_FINAL_OU").Copy
Set wb = ActiveWorkbook
Set ws = ActiveSheet
With wb
With ws
.Range("A:C").SpecialCells(xlCellTypeBlanks).EntireRow.DELETE
.Range(.Cells(1, "C"), .Cells(.Rows.Count, .Columns.Count)).Clear
End With
.SaveAs FileSaveName, xlTextWindows
.Close False
End With
i = MsgBox("Soubor uložen", vbOKOnly + vbInformation)
End Sub
Now I have extended the sheet with additional columns and thus logically extended the code
Sub EXPORT_POR()
Dim wb As Workbook
Dim ws As Worksheet
Dim FileSaveName As Variant
FileSaveName = Application.GetSaveAsFilename(fileFilter:="Text (Tab delimited) (*.*), *.*")
Sheets("POR_FINAL_OU").Copy
Set wb = ActiveWorkbook
Set ws = ActiveSheet
With wb
With ws
.Range("A:G").SpecialCells(xlCellTypeBlanks).EntireRow.DELETE
.Range(.Cells(1, "G"), .Cells(.Rows.Count, .Columns.Count)).Clear
End With
.SaveAs FileSaveName, xlTextWindows
.Close False
End With
i = MsgBox("Soubor uložen", vbOKOnly + vbInformation)
End Sub
Now I get the following error when I start macro
"error 1004 - Cannot use that command on overlapping selections"
I have no idea how to fix it
i solved this way. Juste change this:
With ws
.Range("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.DELETE
.Range(.Cells(1, "G"), .Cells(.Rows.Count, .Columns.Count)).Clear
End With
.SaveAs FileSaveName, xlTextWindows
.Close False
I am using this code which exports activesheet to CSV. However, I am looking to modify this so I can pass as arguments the names of multiple sheets to export.
Sometimes it could be 2 sheets, sometimes it could be 10 sheets and I want to somehow define the names of the sheets as parameters for the export.
Sub saveSheetToCSV()
Dim myCSVFileName As String
Dim tempWB As Workbook
Application.DisplayAlerts = False
On Error GoTo err
myCSVFileName = ThisWorkbook.Path & "\" & "CSV-Exported-File-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
ThisWorkbook.Sheets("YourSheetToCopy").Activate
ActiveSheet.Copy
Set tempWB = ActiveWorkbook
With tempWB
.SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
.Close
End With
err:
Application.DisplayAlerts = True
End Sub
Export Worksheet to New Workbook
!!! denotes places to be checked carefully and possibly modified.
Option Explicit
Sub ExportWorksheetsTEST()
Dim wb As Workbook: Set wb = Workbooks.Open("C:\Test\Test.xlsx")
ExportWorksheets "Sheet1", "Sheet5", "Sheet8"
End Sub
Sub ExportWorksheets(ParamArray WorkSheetNames() As Variant)
Dim dFolderPath As String: dFolderPath = ThisWorkbook.Path & "\"
Const dFileExtension As String = ".csv"
Const dDateFormat As String = "dd-MMM-yyyy hh-mm"
Const dFileNameDelimiter As String = "-"
' This is the requirement.
' The recommendation is to put it as the first parameter of the procedure:
' Sub ExportWorksheets(ByVal wb As Workbook, ParamArray...)!!!
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim dDateString As String: dDateString = VBA.Format(VBA.Now, dDateFormat)
Dim ws As Worksheet
Dim n As Long
Dim dFilePath As String
For n = LBound(WorkSheetNames) To UBound(WorkSheetNames)
On Error Resume Next ' prevent error if worksheet doesn't exist
Set ws = wb.Worksheets(WorkSheetNames(n))
On Error GoTo 0
If Not ws Is Nothing Then
' Build the file path!!!
dFilePath = dFolderPath & ws.Name & dFileNameDelimiter _
& dDateString & dFileExtension
ws.Copy ' copy to a new workbook
With Workbooks(Workbooks.Count)
Application.DisplayAlerts = False ' overwrite w/o confirmation
.SaveAs Filename:=dFilePath, FileFormat:=xlCSV
Application.DisplayAlerts = True
.Close SaveChanges:=False
End With
Set ws = Nothing
End If
Next n
MsgBox "Worksheets exported.", vbInformation
End Sub
Im eliminating the duplicates, that not give any error.
Then i try to select all the row (not the same each time)
giving a error out of range
MyBook.Sheets("Excel").Range("C1:P1000000").Copy .Sheets("Sheet1").Rows("1")
Dim rg As Range
Dim rg2 As Range
Set rg = Range("F2").CurrentRegion
rg.RemoveDuplicates Columns:=1, Header:=xlYes
Dim MyBook As Workbook, newBook As Workbook
Dim FileNm As String
Set MyBook = ThisWorkbook
FileNm = ThisWorkbook.Path & "\" & "TEST-BOOK.xls"
Set newBook = Workbooks.Add
With newBook
MyBook.Sheets("Excel").Range("C1:P1000000").Copy .Sheets("Sheet1").Rows("1")
'Save new wb with XLS extension
.SaveAs Filename:=FileNm, FileFormat:=xlNormal, CreateBackup:=False
.Close Savechanges:=False
End With
dim newWb as workbook
activesheet.cells.copy
set newWb = workbooks.add
newWb .worksheets(1).cells(1,1).pastespecial
Getting control variable in use for this, I guess because of "ws", can someone help how to fix? Thanks
Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String
Set wbThis = ThisWorkbook
For Each ws In wbThis.Worksheets
strFilename = wbThis.Path & "/" & ws.Name
ws.Copy
Set wbNew = ActiveWorkbook
For Each ws In wbNew.Worksheets
ws.Cells.Copy
ws.Cells.PasteSpecial xlPasteValues
wbNew.SaveAs strFilename
wbNew.Close
Next ws
End Sub
Used ws2 and fixed Next statements, works now:
Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim strFilename As String
Set wbThis = ThisWorkbook
For Each ws In wbThis.Worksheets
strFilename = wbThis.Path & "/" & ws.Name
ws.Copy
Set wbNew = ActiveWorkbook
For Each ws2 In wbNew.Worksheets
ws2.Cells.Copy
ws2.Cells.PasteSpecial xlPasteValues
Next
wbNew.SaveAs strFilename
wbNew.Close
Next ws
End Sub
Here is a simplified version of your code:
Sub CreateNewWBs()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Copy
With ActiveWorkbook
.Worksheets(1).UsedRange.Value = .Worksheets(1).UsedRange.Value
.SaveAs ThisWorkbook.Path & "/" & ws.Name
.Close
End With
Next ws
End Sub
I have removed the second For loop, which was causing you issues (both because you had For without Next, and because you were trying to reuse an existing variable) on the basis that wbNew only ever contained 1 worksheet, replaced wbThis with ThisWorksheet, and swapped the .Copy:.PasteSpecial with .Value=.Value to avoid needing the clipboard.
In need of importing an Excel Workbook to the sheets of existing Excel Macro-Enabled Workbook
Have been successful in importing it using the code which the destination is specified I used ".xlsx" as the destination since "*" is used to specify all xlsx file found in the folder.
Sub CopySheets()
Dim WB As Workbook
Dim SourceWB As Workbook
Dim WS As Worksheet
Dim ASheet As Worksheet
'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.EnableEvents = False
'Sets the variables:
Set WB = ActiveWorkbook
Set ASheet = ActiveSheet
Set SourceWB = Workbooks.Open(WB.Path & "\*.xlsx") 'Modify to match
'Copies each sheet of the SourceWB to the end of original wb:
For Each WS In SourceWB.Worksheets
WS.Copy after:=WB.Sheets(WB.Sheets.Count)
Next WS
SourceWB.Close savechanges:=False
Set WS = Nothing
Set SourceWB = Nothing
WB.Activate
ASheet.Select
Set ASheet = Nothing
Set WB = Nothing
Application.EnableEvents = True
End Sub
The error is "Run-time error '1004': Sorry, we couldn't find C:\Users\ZMOLD01\Desktop\CaseStudy Results*.xlsx. Is it possible it was moved, renamed or deleted?
Dir gives you the file name if it is found in the Destination.
Change:
Set SourceWB = Workbooks.Open(WB.Path & "\*.xlsx")
To:
If Len(Dir(wb.path & "\*.xlsx")) > 0 Then
Set SourceWB = Workbooks.Open(wb.path & "\" & Dir(wb.path & "\*.xlsx"))
Else: Msgbox "File Not Found"
End if