D
Darin Kramer
Howdie,
Macro (below)runs fine in the book where it was designed.
Problem is I need to put it into another users personal Macro Workbook
so that they can open files, run the macro, then close the file.
I can see that the Macro is trying to run itself in the personal
workbook (it creates a new tab called Master, and this is being created
in the Personal Macroworkbook, instead of the active workbook)
I cant tell it to refer to a workbookname, as the names of all the
workbooks where it needs to run in will be different.
I appreciate all your suggestions!!
Macro code currently is
Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = Lastrow(DestSh)
sh.Range("b920").Copy DestSh.Cells(Last + 1, "A")
'Instead of this line you can use the code below to copy
only the values
'or use the PasteSpecial option to paste the format
also.
'With sh.Range("A1:C5")
'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
'.Columns.Count).Value = .Value
'End With
'sh.Range("B10:h20").Copy
'With DestSh.Cells(Last + 1, "A")
' .PasteSpecial xlPasteValues, , False, False
' .PasteSpecial xlPasteFormats, , False, False
' Application.CutCopyMode = False
'End With
DestSh.Cells(Last + 1, "p").Value = sh.Name
'This will copy the sheet name in the D column if you
want
End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
Call Delete_specific_row
Call Country_name
Call Remove_data_validation
Call paste_values
End Sub
T H I S A L S O M A Y B E R E L E V A N T
Function Lastrow(sh As Worksheet)
On Error Resume Next
Lastrow = sh.Cells.find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
*** Sent via Developersdex http://www.developersdex.com ***
Macro (below)runs fine in the book where it was designed.
Problem is I need to put it into another users personal Macro Workbook
so that they can open files, run the macro, then close the file.
I can see that the Macro is trying to run itself in the personal
workbook (it creates a new tab called Master, and this is being created
in the Personal Macroworkbook, instead of the active workbook)
I cant tell it to refer to a workbookname, as the names of all the
workbooks where it needs to run in will be different.
I appreciate all your suggestions!!
Macro code currently is
Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = Lastrow(DestSh)
sh.Range("b920").Copy DestSh.Cells(Last + 1, "A")
'Instead of this line you can use the code below to copy
only the values
'or use the PasteSpecial option to paste the format
also.
'With sh.Range("A1:C5")
'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
'.Columns.Count).Value = .Value
'End With
'sh.Range("B10:h20").Copy
'With DestSh.Cells(Last + 1, "A")
' .PasteSpecial xlPasteValues, , False, False
' .PasteSpecial xlPasteFormats, , False, False
' Application.CutCopyMode = False
'End With
DestSh.Cells(Last + 1, "p").Value = sh.Name
'This will copy the sheet name in the D column if you
want
End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
Call Delete_specific_row
Call Country_name
Call Remove_data_validation
Call paste_values
End Sub
T H I S A L S O M A Y B E R E L E V A N T
Function Lastrow(sh As Worksheet)
On Error Resume Next
Lastrow = sh.Cells.find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
*** Sent via Developersdex http://www.developersdex.com ***