Macro to ignore copying data where A2 is blank when opening multiple Files

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,665
Office Version
  1. 2019
Platform
  1. Windows
I have the following macro below to select multiple files and to copy the data

It would be appreciated if someone could kindly amend my code so that if A2 is blank, then the data on those workbooks are not copied. Those where A2 is not Blank are to be copied



Code:
 Sub Open_MultipleFiles()

ChDir "C:\downloads"
A:
Dim A As Variant
Dim LR As Long
A = Application.GetOpenFilename(MultiSelect:=True)
If TypeName(A) = "Boolean" Then Exit Sub

Dim File As Variant

Application.ScreenUpdating = False
For Each File In A
        With Workbooks.Open(File)

     
With Sheets(3)
.Range("a1", .Range("Q" & Rows.Count).End(xlUp)).Copy _
Destination:=ThisWorkbook.Sheets("Import").Range("A" & Rows.Count).End(xlUp)
       '  .Range("a1:M" & Rows.Count).End(xlUp).UnMerge

         

End With

.Close savechanges:=False
End With
Next
Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,316
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
 Sub Open_MultipleFiles()

ChDir "C:\downloads"
A:
Dim A As Variant
Dim LR As Long
A = Application.GetOpenFilename(MultiSelect:=True)
If TypeName(A) = "Boolean" Then Exit Sub

Dim File As Variant

Application.ScreenUpdating = False
For Each File In A
        With Workbooks.Open(File)

     
With .Sheets(3)
   If .Range("a2") <> "" Then
      .Range("a1", .Range("Q" & Rows.Count).End(xlUp)).Copy _
      Destination:=ThisWorkbook.Sheets("Import").Range("A" & Rows.Count).End(xlUp)
             '  .Range("a1:M" & Rows.Count).End(xlUp).UnMerge
   End If
         

End With

.Close savechanges:=False
End With
Next
Application.ScreenUpdating = True
End Sub
 

howard

Well-known Member
Joined
Jun 26, 2006
Messages
5,665
Office Version
  1. 2019
Platform
  1. Windows
Thanks Fluff

Your code works perfectly
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,316
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,365
Messages
5,547,480
Members
410,797
Latest member
mlfuson
Top