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

howard

Well-known Member
Joined
Jun 26, 2006
Messages
6,566
Office Version
  1. 2021
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
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
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
 
Upvote 0
Thanks Fluff

Your code works perfectly
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,215,360
Messages
6,124,489
Members
449,166
Latest member
hokjock

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top