butters149
New Member
- Joined
- Mar 21, 2018
- Messages
- 23
Hello,
I am fairly new to this. What I'm trying to do is find the header and start the copying from there, then copy it to a new worksheet and rename the worksheet with a defined cell in that same worksheet. Then I go back and find the next same header and copy from there to the end of that table, then paste to new worksheet and repeat until all are found. below is my vba.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+g
'
'Find header, copy and paste to new worksheet
Cells.Find(What:="unique header", After:= _
ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.Offset(, 2)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Range("A1:M1").Select
'Rename Worksheet
ActiveSheet.Name = Range("A2")
'Reset
Sheets("Matter Summary").Select
Application.CutCopyMode = False
SendKeys "{down}"
'Reset1
'Find header, copy and paste to new worksheet
Cells.Find(What:="unique header", After:= _
ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.Offset(, 2)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Range("A1:M1").Select
'Rename Worksheet
ActiveSheet.Name = Range("A2")
'Reset
Sheets("Matter Summary").Select
Application.CutCopyMode = False
SendKeys "{down}"
End Sub
I am fairly new to this. What I'm trying to do is find the header and start the copying from there, then copy it to a new worksheet and rename the worksheet with a defined cell in that same worksheet. Then I go back and find the next same header and copy from there to the end of that table, then paste to new worksheet and repeat until all are found. below is my vba.
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+g
'
'Find header, copy and paste to new worksheet
Cells.Find(What:="unique header", After:= _
ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.Offset(, 2)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Range("A1:M1").Select
'Rename Worksheet
ActiveSheet.Name = Range("A2")
'Reset
Sheets("Matter Summary").Select
Application.CutCopyMode = False
SendKeys "{down}"
'Reset1
'Find header, copy and paste to new worksheet
Cells.Find(What:="unique header", After:= _
ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.Offset(, 2)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Range("A1:M1").Select
'Rename Worksheet
ActiveSheet.Name = Range("A2")
'Reset
Sheets("Matter Summary").Select
Application.CutCopyMode = False
SendKeys "{down}"
End Sub