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    
post Jul 8 2019, 04:05 PM

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:

  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:


Option Explicit


'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()
   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
post Jul 8 2019, 04:22 PM

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
post Jul 8 2019, 07:21 PM

Posts: 63
Joined: 23-May 13

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

Go to the top of the page

Posts in this topic

Custom Search

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