Extracting data from various sheets

[segran]

Hi,

I have many sheets. I want to extract data from U7 from each sheet.
Please advise how I can do this quickly and efficiently.

Thank you

 

[Jaye7]

This should work for you.

Sub Add_All_Worksheets()
ActiveWorkbook.Sheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Name = "Total"
    Dim wSheet As Worksheet
    Dim rCopy As Range
    Dim rPaste As Range
    Dim lngLastRow As Long
    Dim lngLastRowCons As Long
    Dim strConsTab As String
 
    strConsTab = "Total" 'Consolidation sheet tab name
 
    'Clear any existing data from the consolidation tab or else each _
    sheet in the work will keep appending to it each time the macro is run.
    lngLastRowCons = Sheets(strConsTab).Cells(Rows.Count, "A").End(xlUp).Row
    If lngLastRowCons > 1 Then
        Sheets(strConsTab).Range("A2:U" & lngLastRowCons).ClearContents
    End If
 
    For Each wSheet In Worksheets
        If wSheet.Name <> strConsTab Then
            With wSheet
                lngLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
                Set rCopy = .Range("U7")
            End With
 
            lngLastRowCons = Sheets(strConsTab).Cells(Rows.Count, "A").End(xlUp).Row
            lngLastRowCons = lngLastRowCons + 1
 
            Set rPaste = Sheets(strConsTab).Range("A" & lngLastRowCons)
            rCopy.Copy
            rPaste.PasteSpecial xlValues
            Application.CutCopyMode = False
        End If
    Next wSheet
    Range("A2").Select
End Sub

 

[Trebor76]

Since you're dealing with a single cell, here's a simplier way - just run it while on the desired output tab:

Option Explicit
Sub Macro1()

    'http://www.mrexcel.com/forum/showthread.php?t=578536

    Dim wrkSheet As Worksheet
    Dim strConsSheet As String
    Dim lngOutputRowNum As Long
        
    Application.ScreenUpdating = False
    
    strConsSheet = ActiveSheet.Name
    
    For Each wrkSheet In ThisWorkbook.Sheets
        
        If wrkSheet.Name <> strConsSheet Then
        
            With Sheets(strConsSheet).Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1)
                .Formula = "=" & wrkSheet.Name & "!$U$7"
                .Value = .Value 'Convert link to a value.  Delete or comment out if not required.
            End With
            
        End If
    
    Next wrkSheet
    
    Application.ScreenUpdating = True

End Sub

Jaye7 - nice code

Note that I wrote that for larger datasets, and therefore some of it is not really applicable here.

Regards,

Robert

 

[Jaye7]

Hi Robert,

Yes, I have an arsenal of over 600 scripts written by many others (including many from you) that I adapt to suite my needs or others needs, but I struggle writing my own scripts as they always seem to go wrong somewhere and it takes me forever to fix them, sometimes they just get scrapped.

 

[Trebor76]

Yes, I have an arsenal of over 600 scripts written by many others (including many from you)

Thanks, that's nice to know my posts are helping you, and hopefully, many others.

 

[segran]

Thank you

Just another question, how do I also get the name of the sheet and many more cells to be copied to a new sheet?

 

[Trebor76]

What range do you want copied and what column do you want the originating tab name in?

 

[segran]

Hi,

Range is U7:W7
Into tab name "TOTAL"

Thank you

 

[Trebor76]

Run this while on the desired output tab (this makes sure the tab actually exists) where Col A is used for the originating tab name while Col's B to D link Col's U to V.

Option Explicit
Sub Macro1()

    'http://www.mrexcel.com/forum/showthread.php?t=578536

    Dim wrkSheet As Worksheet
    Dim strConsSheet As String
    Dim lngOutputRowNum As Long
        
    Application.ScreenUpdating = False
    
    strConsSheet = ActiveSheet.Name
    
    For Each wrkSheet In ThisWorkbook.Sheets
        
        If wrkSheet.Name <> strConsSheet Then
        
            If WorksheetFunction.CountA(Sheets(strConsSheet).Cells) = 0 Then
                lngOutputRowNum = 2 'Defualt row number if there's no data on the 'strConsSheet'. Change to suit.
            Else
                lngOutputRowNum = Sheets(strConsSheet).Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            End If
        
            With Sheets(strConsSheet).Range("B" & lngOutputRowNum & ":D" & lngOutputRowNum)
                If InStr(wrkSheet.Name, " ") = 0 Then
                    .Formula = "=" & wrkSheet.Name & "!U$7"
                Else
                    .Formula = "='" & wrkSheet.Name & "'!U$7"
                End If
                    '.Value = .Value 'Convert links to a values.  Uncomment if required.
            End With
            
            Sheets(strConsSheet).Range("A" & lngOutputRowNum).Value = wrkSheet.Name
            
        End If
    
    Next wrkSheet
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[segran]

Thank You