I am trying to feed Worksheet in Runtime to Paste but get Object Required error.
I have tried playing with passing multiple types but still gives an error.
Please advise, how can I pass this country name in run time value, so code picks that up and copies the template in that worksheet.
Dim helpdesksheet As Worksheet
Dim hdr, cr As Integer
Dim H_lastrow As Long
Dim C_lastrow As Long
Dim cnname As String
Dim PasteStart As Range
Dim Sheet, cnsheet As Worksheet
Dim wb1, wb2 As Workbook
Call Import_Files
H_lastrow = Sheets("HelpDeskFile").Cells(Rows.Count, 1).End(xlUp).Row
C_lastrow = Sheets("Country_Lookup").Cells(Rows.Count, 1).End(xlUp).Row
Set wb1 = ActiveWorkbook
For cr = 2 To 2
cnname = Sheets("Country_Lookup").Cells(cr, 1).Value
If sheetExists(cnname) = True Then
Application.DisplayAlerts = False
wb1.Worksheets(cnname).Delete
Application.DisplayAlerts = True
wb1.Worksheets.Add(After:=Sheets(Worksheets.Count)).Name = cnname
Sheets(cnname).Select
Set PasteStart = [cnname!A1]
With wb1.Sheets("Template").UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
Else
wb1.Worksheets.Add(After:=Sheets(Worksheets.Count)).Name = cnname
cnsheet = wb1.Worksheets(cnname)
Sheets(cnname).Select
Set PasteStart = [cnname!A1]
With wb1.Sheets("Template").UsedRange
.Copy PasteStart
Set PasteStart = PasteStart.Offset(.Rows.Count)
End With
End If
'For hdr = 7 To H_lastrow
'If helpdesksheet.Cells(hdr, 11).Value = cnname Then
'i'll add code later
'End If
'Next hdr
Next cr
Getting Error: Run Time 424 Object Requried
Related
i have a code that loops through a range of cells and for each name in that range it will add a new sheet and name the new sheet after whatever is in the cell. the line of code "ws.Name = Employee_name" is giving me a 1004 runtime error "Application-Defined or Object-Defined error" it is only giving this error the second time through the look it is able to rename the sheet for the first loop. any ideas on how to prevent this?
Option Explicit
Sub read_WFH_dockets()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim WB As Workbook
Dim ws As Worksheet
Dim Employee_name As String
Set WB = ActiveWorkbook
Dim Rng_Employees As Range
Dim EmployeeFAB
Dim numrows As Long
Dim Fab As String
numrows = Range("A100000").End(xlUp).Row
Set Rng_Employees = Range("B1:B" & numrows)
For Each EmployeeFAB In Rng_Employees.Cells
Employee_name = Range("A" & EmployeeFAB.Row)
Fab = EmployeeFAB.Value
Set ws = WB.Sheets.Add
ws.Name = Employee_name
Set ws = Nothing
Employee_name = ""
Fab = ""
Next
End Sub
Here is the sub I am using that splits loops through each tab and split them into multiple workbooks based on the user-specified column, "Manufacturer Name".
Sub SplitSheetIntoMultWkbksBasedOnCol(Col As String)
Dim objWorksheet As Excel.Worksheet
Dim nLastRow, nRow, nNextRow As Integer
Dim strColumnValue As String
Dim objDictionary As Object
Dim varColumnValues As Variant
Dim varColumnValue As Variant
Dim objExcelWorkbook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim wsSheet As Worksheet
For Each wsSheet In Worksheets
If wsSheet.Name <> "Open" Then
wsSheet.Activate
Set objWorksheet = ActiveSheet
nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row
Set objDictionary = CreateObject("Scripting.Dictionary")
For nRow = 2 To nLastRow
'Get the specific Column
strColumnValue = objWorksheet.Range(Col & nRow).Value
If objDictionary.Exists(strColumnValue) = False Then
objDictionary.Add strColumnValue, 1
End If
Next
varColumnValues = objDictionary.Keys
For i = LBound(varColumnValues) To UBound(varColumnValues)
varColumnValue = varColumnValues(i)
'Create a new Excel workbook
Set objExcelWorkbook = Excel.Application.Workbooks.Add
Set objSheet = objExcelWorkbook.Sheets(1)
objSheet.Name = objWorksheet.Name
objWorksheet.Rows(1).EntireRow.Copy
objSheet.Activate
objSheet.Range("A1").Select
objSheet.Paste
For nRow = 2 To nLastRow
If CStr(objWorksheet.Range(Col & nRow).Value) = CStr(varColumnValue) Then
objWorksheet.Rows(nRow).EntireRow.Copy
nNextRow = objSheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1
objSheet.Range("A" & nNextRow).Select
objSheet.Paste
objSheet.Columns("A:B").AutoFit
End If
Next
Next
End If
Next wsSheet
Workbooks("Open_Spreadsheet_Split.xlsm").Activate
Sheets(1).Activate
End Sub
This is ending up making way too many workbooks. So instead, for each tab, I want to copy the rows with the same Manufacturer to the same workbook.
EDIT: make sure headers from each source sheet are included on each destination sheet.
Try this out:
Sub SplitSheetIntoMultWkbksBasedOnCol(Col As String)
Dim wbSrc As Workbook, ws As Worksheet, wsTmp As Worksheet
Dim dict As Object, lastRow As Long, nRow As Long, v
Dim dictHeader As Object 'for tracking whether headers have been copied
Set dict = CreateObject("Scripting.Dictionary")
Set wbSrc = ActiveWorkbook
Application.ScreenUpdating = False
For Each ws In wbSrc.Worksheets
If ws.Name <> "Open" Then
Set dictHeader = CreateObject("Scripting.Dictionary") 'reset header-tracking dictionary
For nRow = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
v = ws.Cells(nRow, Col).Value 'get the specific Column
'need a new workbook?
If Not dict.exists(v) Then
Set wsTmp = Application.Workbooks.Add(xlWBATWorksheet).Worksheets(1) 'add new workbook with one sheet
dict.Add v, wsTmp.Range("A1") 'add key and the first paste destination
End If
'first row from this sheet for this value of `v`?
If Not dictHeader.exists(v) Then
ws.Rows(1).Copy dict(v) 'copy headers from this sheet
Set dict(v) = dict(v).Offset(1, 0) 'set next paste position
dictHeader.Add v, True 'flag header as copied
End If
ws.Rows(nRow).Copy dict(v) 'copy the current row
Set dict(v) = dict(v).Offset(1, 0) 'set next paste position
Next nRow
End If 'not "open" sheet
Next ws
Workbooks("Open_Spreadsheet_Split.xlsm").Activate 'ThisWorkbook?
Sheets(1).Activate
End Sub
I have used this macro several times, but not getting runtime error 9, subscript out of range today? The format of the sheet appears to be the same. Any suggestions on how to correct?
Sub SaveRowsAsTXT()
Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long
Dim filePath As String
Dim fileName As String
Dim rowRange As Range
Dim cell As Range
filePath = "C:\Users\Me\Desktop\Working\SomeName\"
For Each cell In Range("B1", Range("B10").End(xlUp))
Set rowRange = Range(cell.Address, Range(cell.Address).End(xlToRight))
Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Application.DisplayAlerts = False 'will overwrite existing files without asking
r = 1
Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
Set wsTemp = ThisWorkbook.Worksheets(1)
For c = 2 To 16
wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
Next c
fileName = filePath & wsSource.Cells(r, 1).Value
wsTemp.Move
Set wbNew = ActiveWorkbook
Set wsTemp = wbNew.Worksheets(1)
wbNew.SaveAs fileName & ".txt", xlTextWindows 'save as .txt
wbNew.Close
ThisWorkbook.Activate
r = r + 1
Loop
Application.DisplayAlerts = True
Next
End Sub
There are quite a few reasons that you could get this error. It could be that the sheet you are referring to does not exist. Also it could be that your application is losing focus when trying to reference something inside of it. To help pin point the problem, try setting a break point when running the code to see which line exactly is failing
I have an excel worksheet that accepts input from another excel file. This excel file has structured data in which I need to separate individually as sheets. I already have the following code to copy and format that data in a certain range but I need to loop this process for the whole worksheet until there's no more data.
The range currently I set is A2:P20 the next range is 4 rows below and that would be A25:P43.
Option Explicit
Public Sub CopySheetToClosedWorkbook()
Dim fileName
Dim closedBook As Workbook
Dim currentSheet As Worksheet
fileName = Application.GetOpenFilename("Excel Files (*.xls*),*xls*")
If fileName <> False Then
Application.ScreenUpdating = False
Set currentSheet = Application.ActiveSheet
Set closedBook = Workbooks.Open(fileName)
closedBook.Sheets(1).Range("A2:P20").Copy
ThisWorkbook.Worksheets("input").Range("A2").PasteSpecial xlPasteValues
closedBook.Application.CutCopyMode = False
closedBook.Close (True)
Application.ScreenUpdating = True
CopySheetAndRenameByCell2
End If
End Sub
You could do something based on the code below. I have set the last row as 1000, you will need to derrive this from your data.
Sub SplitRangeTest()
Dim lLastRow As Long
Dim lRow As Long
Dim lRangeSize As Long
Dim lSpacerSize As Long
lRangeSize = 19
lRow = 2
lSpacerSize = 4
lLastRow = 1000 ' Get the last populated row in the column of choice here
Do Until lRow > lLastRow
Debug.Print Range("A" & lRow).Resize(lRangeSize, 16).Address
lRow = lRow + lRangeSize + lSpacerSize
Loop
End Sub
Try this:
Public Sub CopySheetToClosedWorkbook()
Dim fileName As String
Dim closedBook As Workbook
Dim currentSheet As Worksheet
fileName = Application.GetOpenFilename("Excel Files (*.xls*),*xls*")
If fileName <> False Then
start_row = 2
rows_to_copy = 19
row_step = 23
Set currentSheet = Application.ActiveSheet
Set closedBook = Workbooks.Open(fileName)
last_row = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For y = start_row To last_row Step row_step
ThisWorkbook.Worksheets("input").Rows(y).Resize(rows_to_copy, 16).Value = closedBook.Sheets(1).Rows(y).Resize(rows_to_copy, 16).Value
Next
Application.ScreenUpdating = True
End If
End Sub
it's worth mentioning here that you set currentSheet but don't actually use it. Also, you shouldn't really use ThisWorkbook like that. Maybe you should be using currentSheet instead (or at least, it's parent).
I'm trying to get a spreadsheet that will import data from another file, scan the file for certain values in column D and then paste specific cells (not the whole row) into the first row that has a blank cell in column F in the new spreadsheet.
This is my updated code now
Sub GetAmazonData()
Dim counter As Integer
Dim LastRow As Long
Dim Adspend As Workbook
Dim A As String
Dim Amazon As Workbook
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Set Adspend = ActiveWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Specify data export file
A = Application.GetOpenFilename(Title:="Select File To Be Processed")
Set Amazon = Application.Workbooks.Open(A)
counter = 2
' While Not Amazon.Worksheets(1).Range("D" & counter) = ""
If Amazon.Worksheets(1).Range("D" & counter) = "B01GB3HZ34" Then
Set targetSheet = Adspend.Worksheets("DirtyDom")
Set sourceSheet = Amazon.Worksheets(1)
LastRow = Adspend.Worksheets("DirtyDom").Cells(Adspend.Worksheets("DirtyDom").Rows.Count, "F").End(xlUp).Row
targetSheet.Range("F" & LastRow).Value = sourceSheet.Range("D" & counter).Value
Else
LastRow = Adspend.Worksheets("DirtyDom").Cells(Adspend.Worksheets("DirtyDom").Rows.Count, "F").End(xlUp).Row
targetSheet.Range("F" & LastRow).Value = sourceSheet.Range("D4").Value
End If
' ActiveCell.Offset(1, 0).Active
' Wend
Amazon.Close
End Sub
I expect this bit of code to paste what is in the imported file's first sheet cell D1 into the sheet called DirtyDom in cell F1 since 1 is the first cell blank in column F.
I get the error Object variable or With block variable not set.
Thank you!
Try something like this, it also puts your loop back in and resets your screen updating and alerts - untested.
Sub GetAmazonData()
Dim Adspend As Workbook
Dim Amazon As Workbook
Dim Targetsheet As Worksheet
Dim Amazonsheet As Worksheet
Dim Amazonfilename As String
Dim lastAmazonrow As Long
Dim lastTargetrow As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Adspend = ActiveWorkbook
Set Targetsheet = Adspend.Worksheets("DirtyDom")
'Specify data export file
Amazonfilename = Application.GetOpenFilename(Title:="Select File To Be Processed")
Set Amazon = Application.Workbooks.Open(Amazonfilename)
Set Amazonsheet = Amazon.Worksheets(1)
lastAmazonrow = Amazonsheet.Cells(Amazonsheet.Rows.Count, "D").End(xlUp).Row
lastTargetrow = Targetsheet.Cells(Targetsheet.Rows.Count, "F").End(xlUp).Row + 1
For counter = 1 To lastAmazonrow
If Amazonsheet.Range("D" & counter) = "B01GB3HZ34" Then
Targetsheet.Range("F" & lastTargetrow).Value = Amazonsheet.Range("D" & counter).Value
Else
Targetsheet.Range("F" & lastTargetrow).Value = Amazonsheet.Range("D4").Value
End If
lastTargetrow = lastTargetrow + 1
Next i
Amazon.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub