collect sheet name:
Sub ListSheets()
Dim ws As Worksheet
Dim x As Integer
x = 1
Sheets("Sheet1").Range("A:A").Clear
For Each ws In Worksheets
Sheets("Sheet1").Cells(x, 1) = [Link]
x = x + 1
Next ws
End Sub
...................................................................................
..
insert workshhet according to list:(by range):
Sub AddSheets()
'Updateby Extendoffice 20161215
Dim xRg As [Link]
Dim wSh As [Link]
Dim wBk As [Link]
Set wSh = ActiveSheet
Set wBk = ActiveWorkbook
[Link] = False
For Each xRg In [Link]("A1:A7")
With wBk
.[Link] after:=.Sheets(.[Link])
On Error Resume Next
[Link] = [Link]
If [Link] = 1004 Then
[Link] [Link] & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next xRg
[Link] = True
End Sub
by selection:
-----------------
Sub AddWorksheetsFromSelection()
Dim CurSheet As Worksheet
Dim Source As Range
Dim c As Range
Set CurSheet = ActiveSheet
Set Source = [Link]
[Link] = False
For Each c In Source
sName = Trim([Link])
If Len(sName) > 0 Then
[Link] After:=Worksheets([Link])
[Link] = sName
End If
Next c
[Link]
[Link] = True
End Sub
-----------------------------------------------------------------------------------
------------------------------
hyprlink sheets:
Sub CreateIndex()
'updateby Extendoffice 20150914
Dim xAlerts As Boolean
Dim I As Long
Dim xShtIndex As Worksheet
Dim xSht As Variant
xAlerts = [Link]
[Link] = False
On Error Resume Next
Sheets("Index").Delete
On Error GoTo 0
Set xShtIndex = [Link](Sheets(1))
[Link] = "Index"
I = 1
Cells(1, 1).Value = "INDEX"
For Each xSht In [Link]
If [Link] <> "Index" Then
I = I + 1
[Link] Cells(I, 1), "", "'" & [Link] & "'!A1", ,
[Link]
End If
Next
[Link] = xAlerts
End Sub
Sub ListSheets()
Dim ws As Worksheet
Dim x As Integer
x = 1
Sheets("Sheet1").Range("A:A").Clear
For Each ws In Worksheets
Sheets("Sheet1").Cells(x, 1).Select
[Link] _
Anchor:=Selection, Address:="", SubAddress:= _
[Link] & "!A1", TextToDisplay:=[Link]
x = x + 1
Next ws
End Sub
-----------------------------------------------------------------------------------
---------------------------------
back to first sheet
-------------------
Sub CreateLinksOnAllSheets()
Dim sh As Worksheet
Dim cell As Range, i As Integer
With ActiveWorkbook
For i = 1 To [Link]
If [Link] <> .Worksheets(i).Name Then
.Worksheets(i).[Link] Anchor:= _
.Worksheets(i).Range("A1"), Address:="", SubAddress:= _
"'" & [Link] & "'" & "!A1", TextToDisplay:="Back"
End If
Next i
End With
End Sub
---------------------------------------------------------------------
Copying Data that Meets Criteria:
Sub Test()
Dim i As Integer
[Link]=False
For i=2 To 101
If Range("B" & i).Value="Ford" Then
Range("B" & i).[Link]
Sheets("Sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
[Link] xlPasteValues
Sheets("Sheet1").Select
End If
Next i
[Link]=True
End Sub
-----------------------------------------------------------------------------------
----------------
Option Explicit
Sub Filter1() 'Excel VBA to use the autofilter then copy
Range("A1:A101").AutoFilter 1, "Ford"
Range("A1:A101").Copy [Link]("A" & [Link]).End(xlUp)(2)
Range("A1").Autofilter 'Off with the autofiltter
End Sub
-----------------------------------------------------------------------------------
-----------
inser n rows
Sub InsertRows()
[Link] = False
Dim numRows As Integer
Dim r As Long
r = Cells([Link], "A").End(xlUp).Row
numRows = 1
For r = r To 1 Step -1
[Link](r + 1).Resize(numRows).Insert
Next r
[Link] = True
End Sub
-----------------------------------------------------------------------------------
---------------------
Sub RenameSheets()
Dim c As Range
Dim J As Integer
J = 0
For Each c In Range("A1:A12")
J = J + 1
If Sheets(J).Name = "Control" Then J = J + 1
Sheets(J).Name = [Link]
Next c
End Sub
