Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify a Macro - Copy Tab Name and Add To Column A
Hello, I have a macro that I want to modify and can't quite figure out. What I want to do is I have many tabs within one workbook. The macro I have copies and pastes certain pieces of information based on my selection. What I want to add is the Tab name that the macro is copying from and insert it in column A. So for instance, if I had two sheets one titled "A" and one titled "B" and this macro takes certain rows from each sheet and combines them into one worksheet based on what I select, I want it to also insert the tab name that the information came from. Below is the macro. Thanks for your help. Sub CreateLinkedSummary2() Dim SNames() As String Dim myAdd As String Dim myRange As Range Dim mySS As Worksheet Dim i As Integer Dim SCnt As Integer Dim myCol As Integer SCnt = ActiveWindow.SelectedSheets.Count If SCnt = 1 Then If MsgBox("Are you sure - only one sheet?", vbYesNo) _ = vbYes Then GoTo ShtOK Else MsgBox "Select the sheets and re-run the macro." Exit Sub End If End If ShtOK: ReDim SNames(1 To SCnt) For i = 1 To SCnt SNames(i) = ActiveWindow.SelectedSheets(i).Name Next i Set myRange = Application.InputBox( _ "Select Range to link from", Type:=8) myAdd = myRange.Address Set myRange = Application.InputBox( _ "Select sheet and range to link to.", Type:=8) Set mySS = myRange.Parent myCol = myRange(1).Column Worksheets(SNames(1)).Range(myAdd).Copy mySS.Select myRange.Select mySS.Paste Link:=True For i = 2 To SCnt Worksheets(SNames(i)).Range(myAdd).Copy mySS.Cells(mySS.Rows.Count, myCol).End(xlUp)(2).Select mySS.Paste Link:=True Next i myRange.Select Application.CutCopyMode = False End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Modify a Macro - Copy Tab Name and Add To Column A
I commented out a few line that I think aren't needed and made one chage. then added the features you wanted. Sub CreateLinkedSummary2() Dim SNames() As String Dim myAdd As String Dim myRange As Range Dim mySS As Worksheet Dim i As Integer Dim SCnt As Integer Dim myCol As Integer SCnt = ActiveWindow.SelectedSheets.Count If SCnt = 1 Then If MsgBox("Are you sure - only one sheet?", vbYesNo) _ = vbYes Then GoTo ShtOK Else MsgBox "Select the sheets and re-run the macro." Exit Sub End If End If ShtOK: ReDim SNames(1 To SCnt) For i = 1 To SCnt SNames(i) = ActiveWindow.SelectedSheets(i).Name Next i Set myRange = Application.InputBox( _ "Select Range to link from", Type:=8) myAdd = myRange.Address Set myRange = Application.InputBox( _ "Select sheet and range to link to.", Type:=8) ''''Set mySS = myRange.Parent myCol = myRange(1).Column Worksheets(SNames(1)).Range(myAdd).Copy '''''mySS.Select '''''myRange.Select ''''from mySS.Paste Link:=True myRange.Paste Link:=True For i = 2 To SCnt Worksheets(SNames(i)).Range(myAdd).Copy LastRow = mySS.Cells(mySS.Rows.Count, myCol).End(xlUp) NewRow = LastRow + 1 mySS.Cells(NewRow, myCol).Paste Link:=True LastRow = mySS.Cells(mySS.Rows.Count, myCol).End(xlUp) mySS.range("A" & NewRow & ":A" & LastRow) = SNames(i) Next i myRange.Select Application.CutCopyMode = False End Sub "ScottMsp" wrote: Hello, I have a macro that I want to modify and can't quite figure out. What I want to do is I have many tabs within one workbook. The macro I have copies and pastes certain pieces of information based on my selection. What I want to add is the Tab name that the macro is copying from and insert it in column A. So for instance, if I had two sheets one titled "A" and one titled "B" and this macro takes certain rows from each sheet and combines them into one worksheet based on what I select, I want it to also insert the tab name that the information came from. Below is the macro. Thanks for your help. Sub CreateLinkedSummary2() Dim SNames() As String Dim myAdd As String Dim myRange As Range Dim mySS As Worksheet Dim i As Integer Dim SCnt As Integer Dim myCol As Integer SCnt = ActiveWindow.SelectedSheets.Count If SCnt = 1 Then If MsgBox("Are you sure - only one sheet?", vbYesNo) _ = vbYes Then GoTo ShtOK Else MsgBox "Select the sheets and re-run the macro." Exit Sub End If End If ShtOK: ReDim SNames(1 To SCnt) For i = 1 To SCnt SNames(i) = ActiveWindow.SelectedSheets(i).Name Next i Set myRange = Application.InputBox( _ "Select Range to link from", Type:=8) myAdd = myRange.Address Set myRange = Application.InputBox( _ "Select sheet and range to link to.", Type:=8) Set mySS = myRange.Parent myCol = myRange(1).Column Worksheets(SNames(1)).Range(myAdd).Copy mySS.Select myRange.Select mySS.Paste Link:=True For i = 2 To SCnt Worksheets(SNames(i)).Range(myAdd).Copy mySS.Cells(mySS.Rows.Count, myCol).End(xlUp)(2).Select mySS.Paste Link:=True Next i myRange.Select Application.CutCopyMode = False End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How do I copy a graph that I want to modify in powerpoint? | Charts and Charting in Excel | |||
Copy, modify and save a spreadsheet a from web application | Excel Programming | |||
Need help with modify this macro to copy. | Excel Programming | |||
Modify macro to copy to next available row | Excel Discussion (Misc queries) | |||
How to modify a copy macro | Excel Worksheet Functions |