Copy entry from each worksheet to new sheet [Solved/Closed]

Report
-
 ishi -
Hello friends,

After reading some very useful suggestions. I thought of posting my problem, hoping i'll find a solution

I have a workbook which has many sheets maybe 10-20, I need to look if in active sheet wherever in column B Project plan name is mentioned i need to copy its adjacent cell details to a new sheet. I need to keep checkin till end of sheet.
Also there's problem, how can i skip worksheets which does not have such entries.

I'll be grateful if sum1 can help me on this


Thanking in advance

2 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
760
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
Hi
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
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
760
What i was trying to say was, this you need to do for every sheet that you have (except for the new sheet)

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
Posts
1
Registration date
Friday August 6, 2010
Status
Member
Last seen
August 10, 2010

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
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
760
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
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
760
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..
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
760
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


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
Hi Rizvisa

That worked perfect..
Thank youuu sooo much:)

God bless u.. u r such an angel