VBA Runtime Error 1004 on Range.Clear - excel

There are a lot of threads about this error, but I can't get this to work no matter what I try. Most people say it occurs when you try to invoke a method on an inactive sheet, but you shouldn't have to do that. Error is on line 28. Thanks.
Private Sub CommandButton1_Click()
Dim x As Integer
Dim boisePaste As Integer
Dim jrgPaste As Integer
Dim master As Integer
Dim lastRow As Integer
Dim bookCount As Integer
bookCount = Application.Workbooks.Count
For x = 1 To bookCount
If Left(Application.Workbooks(x).Name, 14) = "ITEM_INVENTORY" Then
boisePaste = x
ElseIf Left(Application.Workbooks(x).Name, 6) = "report" Then
jrgPaste = x
ElseIf Left(Application.Workbooks(x).Name, 8) = "Portland" Then
master = x
End If
next x
'Unhide sheets and delete Boise range'
Application.ActiveWorkbook.Sheets("BoisePaste").Visible = True
Sheets("JRGpaste").Visible = True
lastRow = Sheets("BoisePaste").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("BoisePaste").Range(Cells(1,2), Cells(lastRow, 23)).Clear
'Open Boise file and copy range, paste in master'
Application.Workbooks(boisePaste).Activate
With ActiveSheet
.Range(.Cells(1,1), .Cells((.Cells(Rows.Count, "A").End(xlUp).Row),22)).Copy
End With
Application.Workbooks(master).Sheets("BoisePaste").Range(B1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Open JRG report and copy range, paste in master'
Application.Workbooks(jrgPaste).Activate
ActiveSheet.Cells.Copy
Application.Workbooks(master).Sheets("JRGpaste").Range(A1).Paste
Application.CutCopyMode = False
'Refresh pivot tables; hide sheets'
Application.Workbooks(master).Activate
With ActiveWorkbook
.RefreshAll
.RefreshAll
.Sheets("BoisePaste").Visible = False
.Sheets("BoisePaste").Visible = False
End With
End Sub

You need to explicitly state which sheet you want the Rows.Count and other such Range uses (Columns,Rows,Cells,etc.) will be on.
Try this:
Sheets("BoisePaste").Range(Sheets("BoisePaste").Cells(1,2), Sheets("BoisePaste").Cells(lastRow, 23)).Clear
So, go through your code and make sure you do this everywhere...i.e. in .Range(.Cells(1,1), .Cells((.Cells(Rows.Count, "A").End(xlUp).Row),22)).Copy, you didn't do it to Rows.Count, so add the sheet there too, to prevent any unexpected actions.
Think of it like this perhaps, with the line
myVariable = Sheets("mySheet").Range(Cells(1,1),Cells(1,2)).Value
VBA is reading that as
In mySheet, look for a range. What range? Hm, the user says Cells(1,1) and Cells(1,2), but what sheet does he want that? The current activesheet is called yourSheet...He specified where the Range should be (sheet called mySheet), but he didn't on Cells(), so I don't know what he wants! mySheet cells(1,1) or yourSheet cells(1,1) ??
(and yes, that's exactly how a computer thinks :P)
Edit: I went through and tried to help tighten up your code. But, as you can see perhaps, I'm not quite positive as to what you want to do, but this should give you some help/insight:
Private Sub CommandButton1_Click()
Dim x As Integer
Dim boisePaste As Integer
Dim jrgPaste As Integer
Dim master As Integer
Dim lastRow As Integer
Dim bookCount As Integer
bookCount = Application.Workbooks.Count
' Create variables to hold the workbook and sheet names.
Dim jrgWS As Worksheet, boiseWS As Worksheet
Dim masterWB As Workbook
Set masterWB = Workbooks(master)
Set jrgWS = Sheets("JRGPaste")
Set boiseWS = Sheets("BoisePaste")
For x = 1 To bookCount
If Left(Application.Workbooks(x).Name, 14) = "ITEM_INVENTORY" Then
boisePaste = x
ElseIf Left(Application.Workbooks(x).Name, 6) = "report" Then
jrgPaste = x
ElseIf Left(Application.Workbooks(x).Name, 8) = "Portland" Then
master = x
End If
Next x
'Unhide sheets and delete Boise range'
Application.ActiveWorkbook.Sheets("BoisePaste").Visible = True
jrgWS.Visible = True
With boiseWS
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range(.Cells(1, 2), .Cells(lastRow, 23)).Clear
End With
'Open Boise file and copy range, paste in master'
'' DONT USE ACTIVE SHEET! Use your variables instead
'Application.Workbooks(boisePaste).Activate
With boiseWS
'Since you want values (xlPasteValues), just set the two ranges equal instead of copy/paste
.Range("B1").Value = .Range(.Cells(1, 1), .Cells((.Cells(.Rows.Count, "A").End(xlUp).Row), 22)).Value
End With
'Open JRG report and copy range, paste in master'
' The below just pastes into the same sheet, no??
jrgWS.Cells.Copy
jrgWS.Range("A1").Paste
Application.CutCopyMode = False
'Refresh pivot tables; hide sheets'
Application.Workbooks(master).Activate
With ActiveWorkbook
.RefreshAll
.RefreshAll
.Sheets("BoisePaste").Visible = False
End With
End Sub

Related

Copying looped data from one workbook and paste to another

I have written this code, and it works when doing it from one sheet to another. (Same workbook). But when i loop through the rows from workbook to workbook i get "Run time error 9" Subscript out of range.
I've checked several times if the filenames are as stated in the code, and it doesn't seem to be the problem. Also if I in the first piece write y.sheets("Tavledisplay") instead of worksheets("Tavledisplay") the debugger tells me there's a problem there. Doing it the latter way, it sends 1 loop of data, and stops at y.sheets("Tavledisplay").Activate.
My code:
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Safecardmaster.xlsm")
Set y = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Tavleark1.xlsm")
a = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Tavledisplay").Cells(i, 14).Value = "Ja" Then
Worksheets("Tavledisplay").Rows(i).Select
Selection.Copy
x.Sheets("Løsninger").Activate
b = Worksheets("Løsninger").Cells(Rows.Count, 1).End(xlUp).Row
x.Sheets("Løsninger").Cells(b + 1, 1).Select
ActiveSheet.Paste
y.Sheets("Tavledisplay").Activate
Selection.ClearContents
End If
Next i
Application.CutCopyMode = False
x.Sheets("Løsninger").Select
I expect the code to loop through all the given rows, where there is a "Ja" in column 14, and pasting them into my other workbook sheet "Løsninger" and deleting them from the other workbook.
You don't need to loop through each loop, a simple filter will do the trick:
Option Explicit
Sub Test()
Dim x As Workbook
Dim y As Workbook
Dim CopyRange As Range
Dim LastRow As Long
Set x = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Safecardmaster.xlsm")
Set y = Workbooks.Open("C:\Users\u054939\Desktop\Diverse filer\Safecard\Tavleark1.xlsm")
'Look for the range to copy and set it
With y.Worksheets("Tabledisplay")
.UsedRange.AutoFilter Field:=14, Criteria1:="Ja"
LastRow = .Cells(.Rows.Count, 14).End(xlUp).Row
Set CopyRange = .Range("A2", .Cells(LastRow, .UsedRange.Columns.Count)).SpecialCells(xlCellTypeVisible)
.AutoFilterMode = False
End With
'Paste it to the other sheet
With x.Worksheets("Løsninger")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
CopyRange.Copy .Cells(LastRow, 1)
End With
'Delete the range from the original sheet
CopyRange.Delete
End Sub

Autofill error on Excel VBA code

trying to work the VBA autofill function (end of code block) but I am running into an error everytime I try the execute the code. I get "Autofill method of Range class failed". Can someone help me out here? Searched google but nothing works. Probably overlooking something small. Thanks in advance for the help.
Sub UpdateLAB() '---> still need to work on this
'author: css
Dim SalesBook As Workbook
Dim ws2 As Worksheet
Dim wspath As String
Dim n As Integer
Dim FirstRow As Long
Dim LastRow As Long
Dim LastRow2 As Long
Dim sourceCol As Integer
Dim RefCellValue2 As String
Dim ps As String
Dim Platts As Workbook
Application.Calculation = xlCalculationAutomatic
Set SalesBook = Workbooks("ALamb.xlsm")
Set ws2 = SalesBook.Worksheets("US LAB Price")
wspath = "C:\Users\scullycs\Desktop\P&O\Platts Data\Platts 2016.xlsm"
FirstRow = ws2.Range("B4").Row
LastRow = ws2.Range("B4").End(xlDown).Row + 1
LastRow2 = ws2.Range("c4").End(xlDown).Row
sourceCol = 2 'refers to the column your data is in
For n = FirstRow To LastRow
RefCellValue2 = Cells(n, sourceCol).Value
If IsEmpty(RefCellValue2) Or RefCellValue2 = "" Then
Cells(n, sourceCol).Offset(0, -1).Copy
SalesBook.Worksheets("Control Page").Range("C8").PasteSpecial (xlPasteValues)
Else
End If
Next n
ps = SalesBook.Worksheets("Control Page").Range("C9").Text
Set Platts = Workbooks.Open(wspath)
Platts.Worksheets(ps).Activate
Range("A13").End(xlDown).Select
Selection.Offset(0, 11).Select
If Selection.Value = "" Then
MsgBox ("Platts data does not exist")
Platts.Close
Else
Selection.Copy
Set SalesBook = Workbooks("ALamb.xlsm")
SalesBook.Worksheets("US LAB Price").Range("b1").End(xlDown).Offset(1, 0).PasteSpecial (xlPasteValues)
'this is where I get the error
SalesBook.Worksheets("US LAB Price").Range("c4").AutoFill Destination:=Range("C4:C" & LastRow2), Type:=xlFillDefault
Platts.Close
End If
End Sub
Most probably your ranges are not overlapping OR range is too big. In case you want to refer, link.
Check the value of LastRow2.
Make sure the fill range is from same sheet to make them over lapping. To do so break your statement into simple steps. Later you can combine.
Will suggest to break down the statement into
Set SourceRange = SalesBook.Worksheets("US LAB Price").Range("C4:C4")
Set fillRange = SalesBook.Worksheets("US LAB Price").Range("C4:C" & LastRow2)
SourceRange.AutoFill Destination:=fillRange, Type:=xlFillDefault

Remove Entire Row if Column Contains $0.00 Value [duplicate]

I have an excel workbook, in worksheet1 in Column A, IF the value of that column = ERR I want it to be deleted (the entire row), how is that possible?
PS: keep in mind that I have never used VBA or Macros before, so detailed description is much appreciated.
Using an autofilter either manually or with VBA (as below) is a very efficient way to remove rows
The code below
Works on the entire usedrange, ie will handle blanks
Can be readily adpated to other sheets by changing strSheets = Array(1, 4). ie this code currently runs on the first and fourth sheets
Option Explicit
Sub KillErr()
Dim ws As Worksheet
Dim lRow As Long
Dim lngCol As Long
Dim rng1 As Range
Dim strSheets()
Dim strws As Variant
strSheets = Array(1, 4)
For Each strws In strSheets
Set ws = Sheets(strws)
lRow = ws.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
lngCol = ws.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
Application.ScreenUpdating = False
ws.Rows(1).Insert
Set rng1 = ws.Range(ws.Cells(1, lngCol), ws.Cells(lRow + 1, lngCol))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=RC1=""ERR"""
.AutoFilter Field:=1, Criteria1:="TRUE"
.EntireRow.Delete
On Error Resume Next
.EntireColumn.Delete
On Error GoTo 0
End With
Next
Application.ScreenUpdating = True
End Sub
sub delete_err_rows()
Dim Wbk as Excel.workbook 'create excel workbook object
Dim Wsh as worksheet ' create excel worksheet object
Dim Last_row as long
Dim i as long
Set Wbk = Thisworkbook ' im using thisworkbook, assuming current workbook
' if you want any other workbook just give the name
' in invited comma as "workbook_name"
Set Wsh ="sheetname" ' give the sheet name here
Wbk.Wsh.activate
' it means Thisworkbook.sheets("sheetname").activate
' here the sheetname of thisworkbook is activated
' or if you want looping between sheets use thisworkbook.sheets(i).activate
' put it in loop , to loop through the worksheets
' use thisworkbook.worksheets.count to find number of sheets in workbook
Last_row = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row 'to find the lastrow of the activated sheet
For i = lastrow To 1 step -1
if activesheet.cells(i,"A").value = "yourDesiredvalue"
activesheet.cells(i,"A").select ' select the row
selection.entirerow.delete ' now delete the entire row
end if
Next i
end sub
Note any operations that you do using activesheet , will be affected on the currently activated sheet
As your saying your a begginner, why dont you record a macro and check out, Thats the greatest way to automate your process by seeing the background code
Just find the macros tab on the sheet and click record new macro , then select any one of the row and do what you wanted to do , say deleting the entire row, just delete the entire row and now go back to macros tab and click stop recording .
Now click alt+F11 , this would take you to the VBA editor there you find some worksheets and modules in the vba project explorer field , if you dont find it search it using the view tab of the VBA editor, Now click on module1 and see the recorded macro , you will find something like these
selection.entirerow.delete
I hope i helped you a bit , and if you need any more help please let me know, Thanks
Fastest method:
Sub DeleteUsingAutoFilter()
Application.ScreenUpdating = False
With ActiveSheet
.AutoFilterMode = False
.Columns("A").AutoFilter Field:=1, Criteria1:="ERR"
.AutoFilter.Range.Offset(1, 0).EntireRow.Delete
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
Second fastest method (lots of variations to this one too):
Sub DeleteWithFind()
Dim rFound As Range, rDelete As Range
Dim sAddress As String
Application.ScreenUpdating = False
With Columns("A")
Set rFound = .Find(What:="ERR", After:=.Resize(1, 1), SearchOrder:=xlByRows)
If Not rFound Is Nothing Then
Set rDelete = rFound
Do
Set rDelete = Union(rDelete, rFound)
Set rFound = .FindNext(rFound)
Loop While rFound.Row > rDelete.Row
End If
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
Autofilter method for multiple sheets:
Sub DeleteUsingAutoFilter()
Dim vSheets As Variant
Dim wsLoop As Worksheet
Application.ScreenUpdating = False
'// Define worksheet names here
vSheets = Array("Sheet1", "Sheet2")
For Each wsLoop In Sheets(vSheets)
With wsLoop
.AutoFilterMode = False
.Columns("A").AutoFilter Field:=1, Criteria1:="ERR"
.AutoFilter.Range.Offset(1, 0).EntireRow.Delete
.AutoFilterMode = False
End With
Next wsLoop
Application.ScreenUpdating = True
End Sub
Assuming there are always values in the cells in column A and that the data is in the first sheet, then something like this should do what you want:
Sub deleteErrRows()
Dim rowIdx As Integer
rowIdx = 1
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
While ws.Cells(rowIdx, 1).Value <> ""
If ws.Cells(rowIdx, 1).Value = "ERR" Then
ws.Cells(rowIdx, 1).EntireRow.Delete
Else
rowIdx = rowIdx + 1
End If
Wend
End Sub

VBA paste range

I would like to copy a range and paste it into another spreadsheet. The following code below gets the copies, but does not paste:
Sub Normalize()
Dim Ticker As Range
Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy
Sheets("Sheet2").Select
Cells(1, 1).Activate
Ticker.PasteSpecial xlPasteAll
End Sub
How can I paste the copies into another sheet?
To literally fix your example you would use this:
Sub Normalize()
Dim Ticker As Range
Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy
Sheets("Sheet2").Select
Cells(1, 1).PasteSpecial xlPasteAll
End Sub
To Make slight improvments on it would be to get rid of the Select and Activates:
Sub Normalize()
With Sheets("Sheet1")
.Range(.Cells(2, 1), .Cells(65, 1)).Copy Sheets("Sheet2").Cells(1, 1)
End With
End Sub
but using the clipboard takes time and resources so the best way would be to avoid a copy and paste and just set the values equal to what you want.
Sub Normalize()
Dim CopyFrom As Range
Set CopyFrom = Sheets("Sheet1").Range("A2", [A65])
Sheets("Sheet2").Range("A1").Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value
End Sub
To define the CopyFrom you can use anything you want to define the range, You could use Range("A2:A65"), Range("A2",[A65]), Range("A2", "A65") all would be valid entries. also if the A2:A65 Will never change the code could be further simplified to:
Sub Normalize()
Sheets("Sheet2").Range("A1:A65").Value = Sheets("Sheet1").Range("A2:A66").Value
End Sub
I added the Copy from range, and the Resize property to make it slightly more dynamic in case you had other ranges you wanted to use in the future.
I would try
Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy
Worksheets("Sheet2").Range("A1").Offset(0,0).Cells.Select
Worksheets("Sheet2").paste
This is what I came up to when trying to copy-paste excel ranges with it's sizes and cell groups. It might be a little too specific for my problem but...:
'**
'Copies a table from one place to another
'TargetRange: where to put the new LayoutTable
'typee: If it is an Instalation Layout table(1) or Package Layout table(2)
'**
Sub CopyLayout(TargetRange As Range, typee As Integer)
Application.ScreenUpdating = False
Dim ncolumn As Integer
Dim nrow As Integer
SheetLayout.Activate
If (typee = 1) Then 'is installation
Range("installationlayout").Copy Destination:=TargetRange '#SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!#####
ElseIf (typee = 2) Then 'is package
Range("PackageLayout").Copy Destination:=TargetRange '#SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!#####
End If
Sheet2.Select 'SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!#####
If typee = 1 Then
nrow = SheetLayout.Range("installationlayout").Rows.Count
ncolumn = SheetLayout.Range("installationlayout").Columns.Count
Call RowHeightCorrector(SheetLayout.Range("installationlayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
ElseIf typee = 2 Then
nrow = SheetLayout.Range("PackageLayout").Rows.Count
ncolumn = SheetLayout.Range("PackageLayout").Columns.Count
Call RowHeightCorrector(SheetLayout.Range("PackageLayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
End If
Range("A1").Select 'Deselect the created table
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
'**
'Receives the Pasted Table Range and rearranjes it's properties
'accordingly to the original CopiedTable
'typee: If it is an Instalation Layout table(1) or Package Layout table(2)
'**
Function RowHeightCorrector(CopiedTable As Range, PastedTable As Range, typee As Integer, RowCount As Integer, ColumnCount As Integer)
Dim R As Long, C As Long
For R = 1 To RowCount
PastedTable.Rows(R).RowHeight = CopiedTable.CurrentRegion.Rows(R).RowHeight
If R >= 2 And R < RowCount Then
PastedTable.Rows(R).Group 'Main group of the table
End If
If R = 2 Then
PastedTable.Rows(R).Group 'both type of tables have a grouped section at relative position "2" of Rows
ElseIf (R = 4 And typee = 1) Then
PastedTable.Rows(R).Group 'If it is an installation materials table, it has two grouped sections...
End If
Next R
For C = 1 To ColumnCount
PastedTable.Columns(C).ColumnWidth = CopiedTable.CurrentRegion.Columns(C).ColumnWidth
Next C
End Function
Sub test ()
Call CopyLayout(Sheet2.Range("A18"), 2)
end sub
You can do something like below to paste values in other ranges. (faster than copying and pasting values)
ThisWorkbook.WorkSheets("Sheet2").Range("A1:A2").Value = Sheets`("Sheet1").Range("A1:A2").Value

run macro on AutoFilter and show data in new sheet

Actually what i want to do , i have following data With Auto Filtering ,
-> I want to create new sheet for each unique Name selected from filtering .i.e. if John and Alex are selected then 2 new sheets should be created one for John and second for Alex , and each of them show own data (Name + No + R). When Next time if master sheet get updated then news data should be appended when i run macro. i'm using following code but its not working 100%.
Sub mycar()
x = 2
Do While Cells(x, 1) <> ""
If Cells(x, 1) = "John" Then
Worksheets("Sheet1").Rows(x).Copy
Worksheets("Sheet2").Activate
eRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Rows(eRow)
End If
Worksheets("Sheet1").Activate
x = x + 1
Loop
End Sub
-> Here it copy only single data Written in the quotes.
-> Second time if i run this code , it is appending same data again with new data.
Help me to avoid this mistakes.
Thank you.
As discussed there is other possibility to set filter parameters in Array in procedure. The code would look like this one:
Sub Solution()
Dim shData As Worksheet
Set shData = Sheets("Arkusz1") 'or other reference to data sheet
Dim shNew As Worksheet
shData.Activate
'get unique values based on Excel features
Range("a1").AutoFilter
Dim myArr As Variant
myArr = Array("John", "max")
Range("a1").AutoFilter
Dim i As Long
For i = 0 To UBound(myArr)
shData.Range("$A$1").AutoFilter Field:=1, Criteria1:=myArr(i), _
Operator:=xlAnd
On Error Resume Next
Sheets(myArr(i)).Range("A1").CurrentRegion.ClearContents
If Err.Number = 0 Then
Range("A1").CurrentRegion.Copy Sheets(myArr(i)).Range("A1")
Else
Set shNew = Sheets.Add(After:=Sheets(Sheets.Count))
shData.Range("A1").CurrentRegion.Copy shNew.Range("A1")
shNew.Name = myArr(i)
Err.Clear
End If
Next i
'removing filter in master sheet
shData.Range("a1").AutoFilter
End Sub
Substitute Worksheets("Sheet1").Rows(x).Copy by Worksheets("Sheet1").Rows(x).EntireRow.Copy
And clear the destination worksheet before adding information.
I do quite similar exercise quite often. Therefore I provide full possible solution with some comments inside the code. It works for all unique values in column A and creates (if not exists) sheet with appropriate name equals to filter parameters.
Sub Solution()
Dim shData As Worksheet
Set shData = Sheets("Arkusz1") 'or other reference to data sheet
Dim shNew As Worksheet
'get unique values based on Excel features
'i guess some will not like it but I do :)
Range("a1").AutoFilter
Range("A1").CurrentRegion.Columns(1).Copy Range("ww1")
Range("ww1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
'be sure that range where you copy (like ww1) is empty range around
Dim myArr As Variant
myArr = Range(Range("ww2"), Range("ww2").End(xlDown))
Range("ww1").CurrentRegion.ClearContents 'some cleaning
Range("a1").AutoFilter '
Dim i As Long
For i = 1 To UBound(myArr, 1)
ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:=myArr(i, 1), _
Operator:=xlAnd
On Error Resume Next
'this is for two reason- to check if appropriate sheet exists, if so to clean top area
'if you need to append you would comment this line
Sheets(myArr(i, 1)).Range("A1").CurrentRegion.ClearContents
If Err.Number = 0 Then
'if you need to append only you would need to set range-to-copy a bit different
Range("A1").CurrentRegion.Copy Sheets(myArr(i, 1)).Range("A1")
Else
Set shNew = Sheets.Add(After:=Sheets(Sheets.Count))
shData.Range("A1").CurrentRegion.Copy shNew.Range("A1")
shNew.Name = myArr(i, 1)
Err.Clear
End If
Next i
End Sub
This could not fully meet your requirements but could be a complete solution to improve accordingly.
Heading ##Below code is as per your requirement. Modify it based upon your requirement.
Private Sub Worksheet_Calculate()
Dim x As Integer
Dim rnge As Integer
x = Range(Selection, Selection.End(xlDown)).Count
rnge = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count
If Range("E1").Value > rnge Then
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Paste
End If
End Sub

Resources