I'm trying to copy paste from an assigned variable worksheet to another.
I've been able to make do by recording but I would like to know how to do it manually.
This is the code I made:
Sub Parse_Reportable()
Dim ws As Worksheet
Sheets.Add.Name = "Copy to Reportable or TAK"
Set ws = Sheets("Copy to Reportable or TAK")
Sheets("sheet1").Select
Range("H3", Cells.Columns(8).End(x1Down)).Copy
ws.Cells(2, 2).Paste
End Sub
Running it creates the worksheet but gives me an
object defined error
in the copy code.
Cells.Columns(8).End(x1Down) will give you the error. It also has a typo. x1Down
Instead of using xlDown, use xlUp to find the last row using THIS and then construct your range to copy.
Is this what you are trying? (Untested)
Option Explicit
Sub Parse_Reportable()
Dim rngToCopy
Dim ws As Worksheet
Dim lRow As Long
Sheets.Add.Name = "Copy to Reportable or TAK"
Set ws = Sheets("Copy to Reportable or TAK")
With Sheets("sheet1")
lRow = .Range("H" & .Rows.Count).End(xlUp).Row
Set rngToCopy = .Range("H3:H" & lRow)
End With
rngToCopy.Copy ws.Cells(2, 2)
End Sub
Note: You may also want to delete the sheet "Copy to Reportable or TAK" if it already exists before naming the new sheet with that name else you will again get an error.
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Copy to Reportable or TAK").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add.Name = "Copy to Reportable or TAK"
Related
I am trying to create a macro which filters an export from our database, copying the filtered results to different sheets and then copying data from those new sheets across to another workbook for further processing. I have been using code from SO which has worked, but now I am trying to combine the two elements (filtering to new sheets, copy to workbooks) I am encountering some problems which as a newbie I haven't been able to solve!
Everytime I run the macro, I get a 'Subscript out of range' error on this line:
Set NAVImperial = NAVExport.Sheets("ROMAN IMPERIAL")
Even though there is definitely a worksheet with this name. Is this something to do with the use of ThisWorkbook?
Thanks in advance!
Sub Sortcodingv2()
Application.ScreenUpdating = False
Dim x As Range
Dim rng As Range
Dim last As Long
Dim sht As String
'specify sheet name in which the data is stored
sht = "236"
'change filter column in the following code
last = Sheets(sht).Cells(Rows.Count, "C").End(xlUp).Row
Set rng = Sheets(sht).Range("A1:O" & last)
Sheets(sht).Range("C1:C" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True
For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=3, Criteria1:=x.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = x.Value
ActiveSheet.Paste
End With
Next x
' Turn off filter
Sheets(sht).AutoFilterMode = False
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
Dim NAVExport As Workbook
Set NAVExport = ThisWorkbook
' Roman Imperial
Dim NAVImperial As Worksheet
Dim LIVEImperial As Workbook
Dim LIVEImperialSheet As Worksheet
Dim UniqueIDs As Range
Dim Descriptions As Range
Dim LastRow As Long
Application.ScreenUpdating = False
Set NAVImperial = NAVExport.Sheets("ROMAN IMPERIAL")
Set LIVEImperial = Workbooks.Open("\\WDMYCLOUDEX2\Public\Sortcoding\Roman Imperial.xlsm")
Set LIVEImperialSheet = LIVEImperial.Sheets("LIVE Data")
With NAVImperial
LastRow = NAVImperial.Cells(Rows.Count, "A").End(xlUp).Row
End With
Set UniqueIDs = NAVImperial.Range("B2:B" & LastRow)
Set Descriptions = NAVImperial.Range("F2:F" & LastRow)
UniqueIDs.Copy
LIVEImperialSheet.Range("A2").PasteSpecial xlPasteValues
Descriptions.Copy
LIVEImperialSheet.Range("B2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
LIVEImperialSheet.Range("C2:O" & LastRow).FillDown
LIVEImperial.Close True
Application.ScreenUpdating = True
The issue is likely that the names don't exactly match, which is why I prefer to avoid Sheets("Name") whenever I can.
If NAVExport is ThisWorkbook then all of its sheets are able to be referenced using their project names, avoiding the use of Sheets("Name"). If you open the Project Explorer (Ctrl+R). You should see a list of worksheets under Microsoft Excel Objects. The default names are Sheet1, Sheet2, Sheet3, etc. Find the one with the name in brackets as ROMAN IMPERIAL and that is the sheet you want to reference.
Then, when writing your code, you can directly write Sheet1.Cells(... or Sheet1.Range(... and you don't need to write Sheets("ROMAN IMPERIAL") anymore.
I have an action log where users can select meeting name, user name, etc through a userform with comboboxes. I have also created a button where users can add a new meeting to the combo box list.
Currently I have a vba code that will check the value of a cell on sheet173 (data entered from userform), create a new sheet named with the cell value and copy the data from sheet173 into the new sheet. The problem I have is that if an action is added and there is already a sheet created for this, I need the data to be added to the next row of that sheet.
I have got the code working up until the point where the sheet is already created but additional rows need to be added. I know the exit sub needs to come out but i'm not sure what to replace it with.
Sub copy_newsheet()
Dim pname
Dim ws As Worksheet
pname = Sheets("Sheet173").Range("A1").Value
For Each ws In ActiveWorkbook.Sheets
If ws.Name = pname Then
Exit Sub
End If
Next ws
Sheets("Sheet173").Range("A1:E1").Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
ActiveSheet.Name = pname
End Sub
This should do it:
Option Explicit
Sub Test()
Dim pname As String
'full quallify your ranges, include the workbook
pname = ThisWorkbook.Sheets("Sheet173").Range("A1").Value 'thisworkbook means the workbook which contains the code
'with this variable we can know if the worksheet exists or not
Dim SheetExists As Boolean
SheetExists = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = pname Then SheetExists = True
Next ws
'check if it doesn't exist
If Not SheetExists Then
'if it doesn't exist, then create the worksheet and give it the name from pname
With ThisWorkbook
.Sheets.Add After:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = pname
End With
End If
'with this variable we can find the last row
Dim LastRow As Long
With ThisWorkbook.Sheets(pname)
'calculate the last row on the pname sheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'equal the value from the pname sheet Range A:E to the sheet173 range A1:E1
.Range(.Cells(LastRow, "A"), .Cells(LastRow, "E")).Value = ThisWorkbook.Sheets("Sheet173").Range("A1:E1").Value
End With
End Sub
You are already pretty close, try this code:
Sub smth()
Dim pname As String
Dim ws As Worksheet, sh As Worksheet
pname = Sheets("Sheet173").Range("A1").Value
For Each sh In ActiveWorkbook.Sheets
If sh.Name = pname Then
Set ws = sh
GoTo Found
End If
Next sh
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = pname
Found:
Sheets("Sheet173").Range("A1:E1").Copy
ws.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End Sub
To explain: If the For loop finds a sheet with the specified namen it will set ws as that sheet and jump to Found:, where the actual copying and pasting happens. If the For loop doesn't find anything it will set ws as a new sheet.
Please note that ActiveWorkbook and ActiveSheet can be prone to causing unwanted errors.
I want to copy the value from current sheet to another workbooks with auto filter by creating new one, once I run the code I got the error:
Object variable or with block variable not set
Here's the code:
Sub copyvaluetoanothersheet()
Dim selectrange As Range
Dim wb As Workbook
Dim Dsheet As Worksheet
Dim Lastrow As Long
Application.ScreenUpdating = False
Set wb = Workbooks.Add
Set Dsheet = wb.Worksheets(1)
Lastrow = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
selectrange = Sheet2.Range("A2:BP" & Lastrow)
With Worksheets("Production data")
.AutoFilterMode = False
selectrange.AutoFilter field:="Branch", Criteria1:="Direct Response"
selectrange.SpecialCells(xlCellTypeVisible).EntireRow.Copy
End With
Dsheet.PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End Sub
Many thanks
You must use Set when assigning object variables (you've done it elsewhere).
Set selectrange = Sheet2.Range("A2:BP" & Lastrow)
Note too that your mixture of sheet code names, tab names, and indexes is confusing, and that your code will error if nothing is visible.
Try following
Sub cpVisible()
Dim MyProdName As String
Dim FilteredRange As Range
Dim myArr As Variant
Sheets("Production Data").Range("$A$2:$BP$50000").AutoFilter Field:="Branch", Criteria1:="Direct Response"
Set FilteredRange = Sheets("Production Data").Range("$A$2:$BP$50000").SpecialCells(xlCellTypeVisible)
FilteredRange.Copy Sheets("Dsheet").Range("A1")
End Sub
I found the code below on this site which works perfectly once I referenced the appropriate cells etc. However, I tried to modify it to keep formulas but I am not having much luck. Any help is greatly appreciated.
Sub test()
Dim names As New Collection
Dim ws As Worksheet, ws1 As Worksheet
Dim wb As Workbook
Dim lastrow As Long
Dim cell As Range
Dim nm As Variant
Dim res As Range
Dim rngHeader As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
'change "A" to column with "Names"
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'change "A" to column with "Names"
For Each cell In .Range("A2:A" & lastrow)
On Error Resume Next
'collect unique names
names.Add CStr(cell.Value), CStr(cell.Value)
On Error GoTo 0
Next cell
'disable all filters
.AutoFilterMode = False
'change "A1:C1" to headers address of your table
Set rngHeader = .Range("A1:C1")
For Each nm In names
With rngHeader
'Apply filter to "Name" column
.AutoFilter Field:=1, Criteria1:=nm
On Error Resume Next
'get all visible rows
Set res = .Offset(2).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
'if there is visible rows, create new WB
If Not res Is Nothing Then
'create new workbook
Set wb = Workbooks.Add
'add sheet with name form column "Names" ("Paul", "Nick" or etc)
wb.Worksheets.Add.name = nm
'delete other sheets from new wb
For Each ws1 In wb.Worksheets
If ws1.name <> nm Then ws1.Delete
Next
'copy/paste data
With wb.Worksheets(nm)
'copy headers
.Range("A1").Resize(, rngHeader.Columns.Count).Value = rngHeader.Value
'copy data
.Range("A2").Resize(res.Rows.Count, res.Columns.Count).Value = res.Value
End With
'save wb
wb.Close saveChanges:=True, Filename:=ThisWorkbook.Path & "\Spreadsheet_" & nm & ".xlsx"
Set wb = Nothing
End If
End With
Next
'disable all filters
.AutoFilterMode = False
End With
Set names = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
There is a part in your code which states that it copies / pastes data:
'copy/paste data
With wb.Worksheets(nm)
'copy headers
.Range("A1").Resize(, rngHeader.Columns.Count).Formula = rngHeader.Formula
'copy data
.Range("A2").Resize(res.Rows.Count, res.Columns.Count).Formula = res.Formula
End With
If you copy the .Formula instead of the .Value then it should work. Give it a try and let us know.
I'm currently doing VBA project which need to copy from a workbook to another, which the WBookPst is the workbook I firstly open (use) meanwhile WBookCopy is the workbook where I open based on the links where I got by listing all ".xslt" format in a File into my Sheet1 of my first workbook. Here is my code :
Sub SortFiles()
'Set up your variables and turn off screen updating.
'Dim iCounter As Integer
Application.ScreenUpdating = False
'Sort the rows based on the data in column C
Columns("A:C").Sort key1:=Range("C2"), _
order1:=xlDescending, Header:=xlYes
Application.ScreenUpdating = True
Dim WBookCopy As Workbook
Dim WBookPst As Workbook
Dim filePath As String
Dim sheetName As String
Dim sheetCopy As Worksheet
Dim sheetPate As Worksheet
Dim rngCopy As Range
Dim rngPst As Range
filePath = Range("B2").Value
Set WBookCopy = Workbooks.Open(filePath)
Columns(30).Insert
For i = 1 To Sheets.count
Cells(i, 30) = Sheets(i).Name
Next i
sheetName = Range("AD1").Value
Set sheetCopy = WBookCopy.Worksheets(sheetName)
Set rngCopy = sheetCopy.Range("A:AA").Copy
Set WBookPst = ThisWorkbook
Set sheetPaste = WBookPst.Worksheets("Sheet1").Activate
Set rngCopy = sheetPaste.Range("A:AA").Select
ActiveSheet.Paste
End Sub
At Set rngCopy = sheetCopy.Range("A:AA").Copy there's error "Objects required".
What does that mean?
By the way, is how I copy and paste the data between sheets correct?
The issue is that rngCopy is of type range and you can't set it equal to a method (copy). Remove the .Copy and you should be fine. You also don't need to set the worksheet out range to a variable. You could just do one line that says WBookCopy.SheetName.Range("A:AA").Copyand then another line to paste.
As #Wyatt mentioned - your copy\paste syntax is incorrect
Here are 2 ways to do it:
Worksheets("Sheet1").Range("A:AA").Copy
Worksheets("Sheet2").Range("A1").PasteSpecial xlPasteAll
or
Worksheets("Sheet1").Range("A:AA").Copy Destination:=Worksheets("Sheet2").Range("A1")