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:

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
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

C
  • Solved
VBA to open file, clear formats and copy paste
Replies
9
Views
342
Alex Blakenburg
A
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
209
shknbk2
S
S
  • Question
Text file creation macro
Replies
5
Views
297
rlv01
R
N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
243
DanteAmor
DanteAmor
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
127
CapRavOr
C

Forum statistics

Threads
1,215,943
Messages
6,127,814
Members
449,409
Latest member
katiecolorado

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