Excel Macro

Solved/Closed
Moe - Jul 1, 2010 at 11:42 AM
 Moe - Jul 8, 2010 at 10:06 AM
Hi I am new to Excel macros, I need help
with the following automation:

I am trying to copy data from the main spreadsheet name "PMO Report" where we have 5 columns D-H and rows 10-114 paste it into different sheets based on the project name in column H. All projects except for the project name TM needs to be copied to the spreadsheets. There are a total of 6 different projects in column H. Project names are (FCS,FCD,FCT,FPD,MSS,TM). So basicly i want to extract whats in "PMO Report" columns D-H into seperate sheet based on the project name except for TM. Thanks in advance for your help...
Regards.
Moe



4 replies

rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jul 3, 2010 at 09:02 AM
Try this

This assumes that the sheet name where the data is be copied is same as the values in the column H of PMO report



Option Explicit

Sub MoveData()
Dim sMasterSht As String
Dim lMasterStartRow As Long
Dim sCopyStartCol As String
Dim sCopyEndCol As String
Dim iLookAtCol As Integer

Dim sExceptSht As String

Dim sPasteStartCol As String
Dim lPasteStartRow As Long

Dim Sheet As Variant
Dim lLastRow As Long
Dim bVisible As Boolean

    sMasterSht = "PMO Report"
    sExceptSht = "TM"
    
    iLookAtCol = 8 ' filter on this column on mastersheet
    lMasterStartRow = 17
    
    sCopyStartCol = "D"
    sCopyEndCol = "H"

    sPasteStartCol = "A"
    lPasteStartRow = 11
    
    Sheets(sMasterSht).Select
        
    For Each Sheet In Sheets
        
        If Sheet.Name = sMasterSht Then GoTo Next_Sheet
        If Sheet.Name = sExceptSht Then GoTo Next_Sheet
        
        Sheets(sMasterSht).Select
        Range(Cells(lMasterStartRow, "A"), Cells(Rows.Count, Columns.Count)).AutoFilter field:=iLookAtCol, Criteria1:="=" & Sheet.Name
        
        lLastRow = Cells(Rows.Count, iLookAtCol).End(xlUp).Row
        If lLastRow <= lMasterStartRow Then GoTo Next_Sheet
        
        Range(Cells(lMasterStartRow + 1, sCopyStartCol), Cells(lLastRow, sCopyEndCol)).Copy
        
        bVisible = True
        If Not (Sheet.Visible) Then
            Sheet.Visible = True
            bVisible = False
        End If
        
        Sheet.Select
        
        lLastRow = Cells(Rows.Count, sPasteStartCol).End(xlUp).Row
        If lLastRow < lPasteStartRow Then lLastRow = lPasteStartRow
        
        Cells(lLastRow, sPasteStartCol).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Cells(lLastRow, sPasteStartCol).Select
        
        If Not bVisible Then Sheet.Visible = False
                
Next_Sheet:
    
    Next Sheet
    
    Sheets(sMasterSht).Select
    ActiveSheet.AutoFilterMode = False
    
End Sub

1
Thank You so much. I really appreciate all the help you have provided. You are the best..............cheers.
0
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jul 1, 2010 at 02:31 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 and 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
0
Hi Rizvisa1 thanks for considering my request. Please find the link below. Thank You

https://authentification.site/files/23222786/PMO_Report.xls
0
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jul 2, 2010 at 11:18 AM
Is data supposed to be appened or over written ?
0
No "Data should remain as is" Not over written. Thanks
0
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jul 3, 2010 at 10:30 AM
Gosh for some reason I am not able to post the solution here.
0
rizvisa1 Posts 4479 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 768
Jul 3, 2010 at 10:50 AM
Well I am unable to post solution here

See this file. It has the solution
https://authentification.site/files/23234958/PMO_Report.xls
0