Loop Opening Files, Copying Data and Closing Files

P

Primordia

New Member
Joined
Oct 29, 2015
Messages
8
Hi,

I am looking for a way to loop a macro for the code below so that I can open an undetermined number of files, copy the information and close the files. The code below opens the first file selected and copies all the data, then the other files are opened and only copy the data and not the header. 10 files are opened total, but I want to be able to open a undetermined number of files each time, but get the same results. Any suggestions?


Code: 
Sub ImportData()
'
' ImportData Macro
'


'
    Dim wbTarget    As Workbook
    Dim wbThis      As Workbook
    Dim FileName    As String


    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Application.DisplayAlerts = False
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("E:E").Select
    Selection.ColumnWidth = 25
    Range("A1").Select
    Selection.AutoFilter
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    
    FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
    
    Set wbThis = ActiveWorkbook
    Set wbTarget = Application.Workbooks.Add(FileName)
    wbTarget.Activate
    
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    wbThis.Activate
    wbThis.Sheets("BOM").Select
    Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    wbTarget.Close False
    
    Application.DisplayAlerts = True
    Range("A2").Select
    Range("A1").Select
End Sub
 
Last edited by a moderator:
Sort by date Sort by votes
You could loop like this:

Code: 
    Do
      FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
      
      If FileName = "False" Then Exit Do
      
      Set wbThis = ActiveWorkbook
      Set wbTarget = Application.Workbooks.Add(FileName)
      wbTarget.Activate
      
      Range("A2").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
      wbThis.Activate
      wbThis.Sheets("BOM").Select
      Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Range("A1").Select
      wbTarget.Close False
    
    Loop
 
Upvote 0
This worked perfectly! Thanks a bunch...


LockeGarmin said:
You could loop like this:

Code: 
    Do
      FileName = Application.GetOpenFilename(fileFilter:="Excel workbook (*.*),*.*", Title:="Locate source file...")
      
      If FileName = "False" Then Exit Do
      
      Set wbThis = ActiveWorkbook
      Set wbTarget = Application.Workbooks.Add(FileName)
      wbTarget.Activate
      
      Range("A2").Select
      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
      wbThis.Activate
      wbThis.Sheets("BOM").Select
      Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Range("A1").Select
      wbTarget.Close False
    
    Loop
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
VBA to Save a New File to One Drive
Replies
2
Views
149
Logit
Logit
D
  • Solved
Trying to copy data from a specific sheet in one workbook to another with VBA
Replies
2
Views
337
druck21
D
E
  • Solved
macro for copying values to the next blank cell
Replies
5
Views
924
Micron
M
C
  • Question Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
489
myall_blues
myall_blues
C
  • Solved
VBA to open file, clear formats and copy paste
Replies
9
Views
662
Alex Blakenburg
A

Share this page

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