UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Macro To Copy Multiple Sheets - Skip Blank Sheets, Office 2013    
 
   
th53
post Jul 8 2019, 04:05 PM
Post#1



Posts: 63
Joined: 23-May 13



Hello everyone, I have a macro I am using to to automate some manual work of copying data from multiple sheets. However, I only want to collect some information on the sheets and am using the following VBA to limit the range:

CODE
  lstrow = Cells(Rows.Count, "B").End(xlUp).Row -5


This works great except when I occasionally run into a blank sheet. Is there a way I can check if a workbook is blank and then skip and move to the next file? Full code below:

CODE

Option Explicit


Const FOLDER_PATH = "C:\Users\Files\"  'REMEMBER END BACKSLASH

'Source: bertie - https://www.mrexcel.com/forum/excel-questions/818972-macro-pull-all-data-every-file-folder-copy-data-into-open-workbook.html

Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long         'output row
   Dim lstrow As Integer

   rowTarget = 2
  
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If
  
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
  
   'set up the target worksheet
   Set wsTarget = Sheets("Sheet1")
  
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xlsx")
  
   Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
      
      lstrow = Cells(Rows.Count, "B").End(xlUp).Row - 5
      
      
      'import the data
      With wsTarget
      
            wsSource.Range("B5:L" & lstrow).Copy wsTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

        
         'optional source filename in the last column
         '.Range("N" & rowTarget).Value = sFile
      End With
      
      'close the source workbook, increment the output row and get the next file
      wbSource.Close savechanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
  
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
  
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub


Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function


Thanks in advance for the help!!
Go to the top of the page
 
 
Start new topic
Replies
June7
post Jul 8 2019, 04:22 PM
Post#2



Posts: 1,305
Joined: 25-January 16
From: The Great Land


If there is data, is there a particular cell that can be depended on to have value?

--------------------
Attachments Manager is below the edit post window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Go to the top of the page
 
th53
post Jul 8 2019, 07:21 PM
Post#3



Posts: 63
Joined: 23-May 13



Hi June, cell B6 would always be populated if there is data present.

Thanks,
Go to the top of the page
 

Posts in this topic



Custom Search


RSSSearch   Top   Lo-Fi    31st March 2020 - 05:27 AM