VBA to extract info from one tab in several workbooks

[elpepe1970]

Dear Members:
I'm looking for a VBA, to extract info withing a folder with 30 Excel workbooks, named as location1 to location30, each workbook has several tabs, one of them is called report and from that tab I need to copy line 6 as only values an paste the data to a new workbook; so finally the new workbook contain the 30 rows with only values from the 30 report tabs. Is it possible?

 

[Zot]

Dear Members:
I'm looking for a VBA, to extract info withing a folder with 30 Excel workbooks, named as location1 to location30, each workbook has several tabs, one of them is called report and from that tab I need to copy line 6 as only values an paste the data to a new workbook; so finally the new workbook contain the 30 rows with only values from the 30 report tabs. Is it possible?

This is possible if I understood it right. However, probably you need to provide a bit more detail.

There is a folder which inside has 30 workbooks. Each workbooks has several tabs and one of the tabs is called Report.
You want to copy value of line 6 from each Report sheets and write the values into another workbook.

Question:
What is the column of that line 6 data?

 

[HighAndWilder]

Dear Members:
I'm looking for a VBA, to extract info withing a folder with 30 Excel workbooks, named as location1 to location30, each workbook has several tabs, one of them is called report and from that tab I need to copy line 6 as only values an paste the data to a new workbook; so finally the new workbook contain the 30 rows with only values from the 30 report tabs. Is it possible?

This code will do as you want.

It allows you to choose the files from which to copy row 6.

It names the new destination workbook 'Destination'. You can change this.

It assumes that all of the selected workbooks have a worksheet named 'Report'

Further checks can be added if necessary.

Public Sub subCopyRows()
Dim Ws As Worksheet
Dim lngCount As Long
Dim lngRow As Long
Dim Wb As Workbook
Dim strPath As String

  strPath = ActiveWorkbook.Path
  
  On Error Resume Next
  Kill (strPath & "\Destination.xlsx")
  On Error GoTo 0
  
  Set Wb = Workbooks.Add
  
' State the name of the destination workbook here.
  ActiveWorkbook.SaveAs strPath & "\Destination.xlsx"
  
  Set Ws = ActiveSheet
  
  lngRow = 2
 
  Application.ScreenUpdating = False
 
  With Application.FileDialog(msoFileDialogOpen)
        
    .AllowMultiSelect = True
        
    .Show
 
    For lngCount = 1 To .SelectedItems.Count
            
      Workbooks.Open .SelectedItems(lngCount)
            
      Worksheets("Report").Rows(6).Copy Ws.Rows(lngRow)
      
      lngRow = lngRow + 1
      
      ActiveWorkbook.Close False
          
    Next lngCount
    
    MsgBox "Rows Copied.", vbOKOnly, "Confirmation"
 
  End With
  
  Application.ScreenUpdating = True
   
End Sub

 

[Zot]

This is possible if I understood it right. However, probably you need to provide a bit more detail.

There is a folder which inside has 30 workbooks. Each workbooks has several tabs and one of the tabs is called Report.
You want to copy value of line 6 from each Report sheets and write the values into another workbook.

Question:
What is the column of that line 6 data?

My bad. You want to copy whole line 6

 

[Zot]

Here is another possible solution. Create a workbook and put the macro below in it.

When you run macro, it will ask for a folder. This would be the folder where you store all your data workbooks. The macro will loop through all the workbook in it and the result would be in the workbook with this macro. It will look for Report sheet.

Option Explicit

Sub GetLine6Data()

Dim SelectFolder As Integer
Dim n As Long, eCol As Long
Dim strPath As String
Dim wbSummary As Workbook, wb As Workbook
Dim wsSummary As Worksheet, ws As Worksheet
Dim FSO As Object
Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim sFileName As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
Set wbSummary = ActiveWorkbook
Set wsSummary = wbSummary.Sheets("Sheet1")
SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show

If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Application.ScreenUpdating = False
'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(strPath)

n = 0
'Loop through each file in a folder
For Each sFileName In FSOFolder.Files
    Set wb = Workbooks.Open(sFileName)
    Set ws = wb.Sheets("Report")
    n = n + 1
    eCol = ws.Cells(6, ws.Columns.Count).End(xlToLeft).Column
    ws.Range(ws.Cells(6, 1), ws.Cells(6, eCol)).Copy
    wsSummary.Range("A" & n).PasteSpecial (xlPasteValues)
    wb.Close True
Next
Application.Goto wsSummary.Range("A1")
Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Application.ScreenUpdating = True

End Sub

 

[elpepe1970]

This code will do as you want.

It allows you to choose the files from which to copy row 6.

It names the new destination workbook 'Destination'. You can change this.

It assumes that all of the selected workbooks have a worksheet named 'Report'

Further checks can be added if necessary.

Public Sub subCopyRows()
Dim Ws As Worksheet
Dim lngCount As Long
Dim lngRow As Long
Dim Wb As Workbook
Dim strPath As String

  strPath = ActiveWorkbook.Path
 
  On Error Resume Next
  Kill (strPath & "\Destination.xlsx")
  On Error GoTo 0
 
  Set Wb = Workbooks.Add
 
' State the name of the destination workbook here.
  ActiveWorkbook.SaveAs strPath & "\Destination.xlsx"
 
  Set Ws = ActiveSheet
 
  lngRow = 2
 
  Application.ScreenUpdating = False
 
  With Application.FileDialog(msoFileDialogOpen)
       
    .AllowMultiSelect = True
       
    .Show
 
    For lngCount = 1 To .SelectedItems.Count
           
      Workbooks.Open .SelectedItems(lngCount)
           
      Worksheets("Report").Rows(6).Copy Ws.Rows(lngRow)
     
      lngRow = lngRow + 1
     
      ActiveWorkbook.Close False
         
    Next lngCount
   
    MsgBox "Rows Copied.", vbOKOnly, "Confirmation"
 
  End With
 
  Application.ScreenUpdating = True
  
End Sub

Thanks for the effort coding this VBA piece, I've tested it. Unfortunately, the code didn't copy row 6 as only values, but as a reference to the source cells. Row 6 contains formulas or references to other cells. It goes from column A to AA, and it's necessary to copy the data as values. Thanks in advance for the improvements

 

[elpepe1970]

Here is another possible solution. Create a workbook and put the macro below in it.

When you run macro, it will ask for a folder. This would be the folder where you store all your data workbooks. The macro will loop through all the workbook in it and the result would be in the workbook with this macro. It will look for Report sheet.

Option Explicit

Sub GetLine6Data()

Dim SelectFolder As Integer
Dim n As Long, eCol As Long
Dim strPath As String
Dim wbSummary As Workbook, wb As Workbook
Dim wsSummary As Worksheet, ws As Worksheet
Dim FSO As Object
Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim sFileName As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
Set wbSummary = ActiveWorkbook
Set wsSummary = wbSummary.Sheets("Sheet1")
SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show

If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Application.ScreenUpdating = False
'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(strPath)

n = 0
'Loop through each file in a folder
For Each sFileName In FSOFolder.Files
    Set wb = Workbooks.Open(sFileName)
    Set ws = wb.Sheets("Report")
    n = n + 1
    eCol = ws.Cells(6, ws.Columns.Count).End(xlToLeft).Column
    ws.Range(ws.Cells(6, 1), ws.Cells(6, eCol)).Copy
    wsSummary.Range("A" & n).PasteSpecial (xlPasteValues)
    wb.Close True
Next
Application.Goto wsSummary.Range("A1")
Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Application.ScreenUpdating = True

End Sub

Thnaks, thanks, thanks, nicely done, works perfect, a lot of work has been reduced to seconds, making reporting easier. I appreciate it so much. Thanks again, for sharing your knowledge.

 

[HighAndWilder]

Thanks for the effort coding this VBA piece, I've tested it. Unfortunately, the code didn't copy row 6 as only values, but as a reference to the source cells. Row 6 contains formulas or references to other cells. It goes from column A to AA, and it's necessary to copy the data as values. Thanks in advance for the improvements

Sorry about that.

Try this.

Public Sub subCopyRows()
Dim Ws As Worksheet
Dim lngCount As Long
Dim lngRow As Long
Dim Wb As Workbook
Dim strPath As String

  strPath = ActiveWorkbook.Path
  
  On Error Resume Next
  Kill (strPath & "\Destination.xlsx")
  On Error GoTo 0
  
  Set Wb = Workbooks.Add
  
  ActiveWorkbook.SaveAs strPath & "\Destination.xlsx"
  
  Set Ws = ActiveSheet
  
  lngRow = 2
 
  Application.ScreenUpdating = False
 
  With Application.FileDialog(msoFileDialogOpen)
        
    .AllowMultiSelect = True
        
    .Show
 
    For lngCount = 1 To .SelectedItems.Count
            
      Workbooks.Open .SelectedItems(lngCount)
            
      Worksheets("Report").Rows(6).Copy
      
      Ws.Range("A" & lngRow).PasteSpecial xlPasteValues
      
      Application.CutCopyMode = False
      
      lngRow = lngRow + 1
      
      ActiveWorkbook.Close False
          
    Next lngCount
    
    MsgBox "Rows Copied.", vbOKOnly, "Confirmation"
 
  End With
  
  Application.ScreenUpdating = True
   
End Sub

 

[elpepe1970]

Sorry about that.

Try this.

Public Sub subCopyRows()
Dim Ws As Worksheet
Dim lngCount As Long
Dim lngRow As Long
Dim Wb As Workbook
Dim strPath As String

  strPath = ActiveWorkbook.Path
 
  On Error Resume Next
  Kill (strPath & "\Destination.xlsx")
  On Error GoTo 0
 
  Set Wb = Workbooks.Add
 
  ActiveWorkbook.SaveAs strPath & "\Destination.xlsx"
 
  Set Ws = ActiveSheet
 
  lngRow = 2
 
  Application.ScreenUpdating = False
 
  With Application.FileDialog(msoFileDialogOpen)
      
    .AllowMultiSelect = True
      
    .Show
 
    For lngCount = 1 To .SelectedItems.Count
          
      Workbooks.Open .SelectedItems(lngCount)
          
      Worksheets("Report").Rows(6).Copy
    
      Ws.Range("A" & lngRow).PasteSpecial xlPasteValues
    
      Application.CutCopyMode = False
    
      lngRow = lngRow + 1
    
      ActiveWorkbook.Close False
        
    Next lngCount
  
    MsgBox "Rows Copied.", vbOKOnly, "Confirmation"
 
  End With
 
  Application.ScreenUpdating = True
 
End Sub

Thanks for the quick correction, works very well too; exactly the way it needed. Thanks for sharing your knowledge.