VBA code to transfer information from multiple sheets onto an existing master sheet.

[helen62]

Hello,

I am a beginner when it comes to VBA codes and would really be grateful for any help. I need a VBA code to create a summary list of selected information from employee wage sheets on to a wage book summary. I have spent hours trying to work out a code to suit my needs but am having difficulty getting it right.

I have a single Excel workbook with multiple sheets. About half of the worksheets are wage sheets and the rest of the sheets have other uses. I need to extract information from the wage sheets and list them onto an existing worksheet named Wage Book Summary which sits in the middle of the same workbook. The wage sheets have identical layouts, only the information contained in them is different. The information I would like to extract sits in columns CD to CL of row 200 in all of the wage sheets. Row 200 in the other sheets is blank

The information needs to be placed in the Wage Book Summary worksheet in columns AE to AM starting at row 4 In and listed downwards from there. Any worksheet without information in row 200 would need to be skipped. The number of worksheets are constantly changing. Each time I run the code I would like to overwrite the previous information in the Wage Book Summary so that the totals are always updated.

Thanks in advance!

 

[Dryver14]

Place code in a module and make sure Wage Book Summary is the activesheet

Sub KWGetInfoFromSheets()


    Dim ws As Worksheet
    Dim i As Long
    
    i = 4
    
     ' clear cells CD to CL and 400 rows down 31 to 39 and 82 to 90
    
    ActiveSheet.Cells(4, 31).Resize(400, 9).ClearContents
       
    For Each ws In ActiveWorkbook.Worksheets
        If Not ws.Name = ActiveSheet.Name Then
            If ws.Cells(200, 82) <> "" Then
                ws.Cells(200, 82).Resize(1, 9).Copy ActiveSheet.Cells(i, 31)
                i = i + 1
            Else
            End If
        End If
    Next ws
        
End Sub

 

[helen62]

Thank you for your help, I am nearly there except for one problem..
I should have mentioned that the cells I am extracting from contain formulas so I am receiving errors in the summary sheet.
I need to copy and paste the values only from the source sheets.

 

[Dryver14]

Sub KWGetInfoFromSheets()


    Dim ws As Worksheet
    Dim i As Long
    
    i = 4
    
     ' clear cells CD to CL and 400 rows down 31 to 39 and 82 to 90
    
    ActiveSheet.Cells(4, 31).Resize(400, 9).ClearContents
       
    For Each ws In ActiveWorkbook.Worksheets
        If Not ws.Name = ActiveSheet.Name Then
            If ws.Cells(200, 82) <> "" Then
                ws.Cells(200, 82).Resize(1, 9).Copy
                ActiveSheet.Cells(i, 31).PasteSpecial Paste:=xlPasteValues
                i = i + 1
            Else
            End If
        End If
    Next ws
        
End Sub

 

[helen62]

Works Perfectly!
Thank you Dryver14, you're a legend!!

 

[Dryver14]

Your welcome