Copy entry from each worksheet to new sheet
Solved/Closed
Related:
- Copy entry from each worksheet to new sheet
- Transfer data from one excel worksheet to another automatically - Guide
- Little alchemy cheat sheet - Guide
- Google sheet right to left - Guide
- How to screenshot excel sheet - Guide
- Cmd network commands cheat sheet - Guide
2 responses
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Aug 6, 2010 at 11:14 AM
Aug 6, 2010 at 11:14 AM
For each sheet, filter on the project
if you get more than one row ( assuming that first row is a header), then copy the data to your other sheet
if you do not have rows, then go to next sheet
if you get more than one row ( assuming that first row is a header), then copy the data to your other sheet
if you do not have rows, then go to next sheet
ishika66
Posts
1
Registration date
Friday August 6, 2010
Status
Member
Last seen
August 10, 2010
Aug 10, 2010 at 02:30 AM
Aug 10, 2010 at 02:30 AM
Hi Rizvisa
thanks.. Got what you r tryin to say.
but the problem is there are lot of merged cells so cant filter the sheet
I wrote the following code
Sub ppcopy()
Windows("reports.xls").Activate
Sheets("new").Activate
Cells(3, 2).Value = Sheets("Phone").Name
Sheets("Phone").Select
Range("B52").Select
Cells.Find(What:="Project Name", After:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("new").Select
Cells(3, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Phone").Select
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 1).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("new").Select
Cells(4, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
But now problem is: i am unable to do it for all the sheets in the workbook
and secondly i need to loop through entire sheet only if next cell to project name is not blank then i need to copy its value else it should check in next sheet.
and i need to copy values of activecell's offset(-1,1) and(1,1) to new sheet
thanks.. Got what you r tryin to say.
but the problem is there are lot of merged cells so cant filter the sheet
I wrote the following code
Sub ppcopy()
Windows("reports.xls").Activate
Sheets("new").Activate
Cells(3, 2).Value = Sheets("Phone").Name
Sheets("Phone").Select
Range("B52").Select
Cells.Find(What:="Project Name", After:=ActiveCell, LookIn:=xlValues _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("new").Select
Cells(3, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Phone").Select
Cells.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 1).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("new").Select
Cells(4, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
But now problem is: i am unable to do it for all the sheets in the workbook
and secondly i need to loop through entire sheet only if next cell to project name is not blank then i need to copy its value else it should check in next sheet.
and i need to copy values of activecell's offset(-1,1) and(1,1) to new sheet
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Aug 10, 2010 at 02:22 PM
Aug 10, 2010 at 02:22 PM
Could you please upload a sample EXCEL file WITH sample data, macro, formula , conditional formatting etc on some shared site like https://authentification.site , http://docs.google.com, http://wikisend.com/ , http://www.editgrid.com etc
A N D post back here the link to allow better understanding of how it is now and how you foresee. Based on the sample book, could you re-explain your problem too
A N D post back here the link to allow better understanding of how it is now and how you foresee. Based on the sample book, could you re-explain your problem too
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Aug 11, 2010 at 07:38 AM
Aug 11, 2010 at 07:38 AM
I think I am understanding what you want, but could you upload a file with some data along with the resulting desired output.
Hi
Please find file on below link. I have entered relevant data
https://authentification.site/files/23756977/Book1.xlsx
I hope it helps you understand my query.. desired output is on sheet new..
and thank you so much for taking out time to solve my problem..
Please find file on below link. I have entered relevant data
https://authentification.site/files/23756977/Book1.xlsx
I hope it helps you understand my query.. desired output is on sheet new..
and thank you so much for taking out time to solve my problem..
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Aug 11, 2010 at 02:19 PM
Aug 11, 2010 at 02:19 PM
Here is one idea. This is not bullet proof (if there is any thing like that in the first place. It assumes that Cell containing "Project Name" would appear before cell containing "Total"
and that there would always be a pair of "Project Name" and 'Total" and that
One row above where "Project Name" appear and the row where "total" appears mark the complete block of information
and that there would always be a pair of "Project Name" and 'Total" and that
One row above where "Project Name" appear and the row where "total" appears mark the complete block of information
Sub CopyValues()
Dim sNewSht As String
Dim sProjName As String
Dim lRow As Long
Dim lNewRow As Long
Dim Sheet As Variant
Dim lLastRow As Long
ThisWorkbook.Activate
sNewSht = "New"
On Error Resume Next
Sheets(sNewSht).Delete
On Error GoTo 0
Sheets.Add
ActiveSheet.Name = sNewSht
lNewRow = 1
Cells(lNewRow, "A") = "Dashboard Name"
Cells(lNewRow, "B") = "Project Name"
Cells(lNewRow, "C") = "Contract/SOW Name"
Cells(lNewRow, "D") = "Project Type"
Cells(lNewRow, "E") = "Billing Code"
Cells(lNewRow, "F") = "Estimated Time To Complete-US"
Cells(lNewRow, "G") = "Estimated Time To Complete-India"
For Each Sheet In Sheets
If Sheet.Name = sNewSht Then GoTo Next_Sheet
Sheet.Select
lLastRow = Cells(Rows.Count, "B").End(xlUp).Row
For lRow = 1 To lLastRow
If (Cells(lRow, "B") = "Project Plan Name") Then
If (Cells(lRow, "C") = vbNullString) Then
sProjName = vbNullString
Else
sProjName = Cells(lRow, "C")
With Sheets(sNewSht)
.Cells(lNewRow, "A") = Sheet.Name
.Cells(lNewRow, "B") = Cells(lRow, "C")
.Cells(lNewRow, "C") = Cells(lRow - 1, "C")
.Cells(lNewRow, "D") = Cells(lRow + 2, "C")
.Cells(lNewRow, "E") = Cells(lRow + 1, "C")
End With
End If
ElseIf ((Cells(lRow, "B") = "Total") And (sProjName <> vbNullString)) Then
With Sheets(sNewSht)
.Cells(lNewRow, "F") = Cells(lRow, "K")
.Cells(lNewRow, "G") = Cells(lRow, "L")
End With
sProjName = vbNullString
lNewRow = lNewRow + 1
End If
Next
Next_Sheet:
Next
End Sub
Aug 9, 2010 at 12:57 AM
thanks for the help
I need to run a macro for the same. since i am new I cudnt really understand wat u r tryin to tel
Aug 9, 2010 at 10:34 AM
1. Filter the sheet on column B for Project plan name. Now if the sheet had the project name, it will show you more than one row and that can be copied. If not you can move to step 3
2. Copy the visible rows and paste to the new sheet
3. process the next sheet in same was as step 1 and 2 till there are no more sheets to be processed.
If you record you action, it will give you a good template to start from