Results 1 to 5 of 5
  1. #1
    New Lounger
    Join Date
    Mar 2016
    Posts
    4
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Merging documents

    Good day All,

    I have been tasked to import +-500 spreadsheet's data into one master file.

    I have been playing around with some of the loops that I have found and tried modifying them to suit my needs but with no luck.

    Basically there is a folder with all the spreadsheets in, all the spreadsheets have exactly the same format and there is only certain information required from each (Date, Site Number and serial numbers), which is conveniently in the exact same range in each spreadsheet.

    Now we get to my problem, I have created a "Import" sheet which acts as a format stripper and a place to copy the data from, bur the problem is that i have to open each one manually and copy from the file to my import sheet and then run my macro.
    Please see code below:

    Sub ImportData()
    '
    '
    ' Statements
    Dim ws As Worksheet

    ' Copy T Number
    Sheets("Import").Select
    Set ws = ThisWorkbook.ActiveSheet
    With ws
    ThisWorkbook.ActiveSheet.Cells.ClearFormats
    End With
    Range("N3").Select
    Selection.Copy

    ' Select Details and paste date
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, -1).Activate
    ActiveSheet.Paste

    ' Copy Date
    Sheets("Import").Select
    Range("N4").Select
    Selection.Copy

    ' Select Date and paste date
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 1).Activate
    ActiveSheet.Paste

    ' Select Batteries string 1
    Sheets("Import").Select
    Range("C19:C22").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    ' Select Batteries string 2
    Sheets("Import").Select
    Range("G19:G22").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste

    ' Select Batteries string 3
    Sheets("Import").Select
    Range("K19:K22").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste

    ' Select Batteries string 4
    Sheets("Import").Select
    Range("O19:O22").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste
    '
    '
    ' Select Batteries string 5
    Sheets("Import").Select
    Range("C27:C30").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    ' Select Batteries string 6
    Sheets("Import").Select
    Range("G27:G30").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste

    ' Select Batteries string 7
    Sheets("Import").Select
    Range("K27:K30").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste

    ' Select Batteries string 8
    Sheets("Import").Select
    Range("O27:O30").Select
    Selection.Copy

    ' Select Batteries column and paste
    Sheets("Details").Select
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    ' Activate cells
    Sheets("Import").Select
    Range("A1").Activate


    End Sub

    Now is it possible to run that macro with a loop? possibly with a folder picker?

    Regards and thanks in advance,
    Gabushna
    Attached Files Attached Files

  2. #2
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,819
    Thanks
    133
    Thanked 480 Times in 457 Posts
    Hi Gabushna

    Welcome to the Lounge as a new poster!

    I think your method of using an Import sheet is great.
    But, instead of grabbing chunks of the data via vba, you could use another sheet to 'fetch' the data from the import sheet into the order you need, using formulas, and then just copy that block of data in one pass and paste as values onto the [Details] sheet.

    zeddy

  3. #3
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,819
    Thanks
    133
    Thanked 480 Times in 457 Posts
    Hi Gabushna

    The attached file shows my method.
    I have assumed that each record should have a date.

    I have added a line in the code to delete any records with duplicate serial numbers

    zeddy
    Attached Files Attached Files

  4. #4
    New Lounger
    Join Date
    Mar 2016
    Posts
    4
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by zeddy View Post
    Hi Gabushna

    The attached file shows my method.
    I have assumed that each record should have a date.

    I have added a line in the code to delete any records with duplicate serial numbers

    zeddy
    This worked like a charm, I have however managed to do it the long way.

    Sub OpenFiles2()

    ' Statements
    Dim MyFolder As String
    Dim MyFile As String
    Dim ws As Worksheet
    ' End Statements

    'Loop
    MyFolder = "c:\TEST"
    MyFile = Dir(MyFolder & "\*.xl??")
    Do While MyFile <> ""

    Application.ScreenUpdating = True

    'Copy 1 - T Number
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Worksheets("Sheet1").Range("A1:R200").ClearFormats
    Range("N3").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, -1).Activate
    ActiveSheet.Paste


    'Copy 2 - Date
    ' Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    ' Sheets("Sheet1").Select
    ' Range("N4").Select
    ' Application.CutCopyMode = False
    ' Selection.Copy
    ' ActiveWorkbook.Close True
    ' Windows("All serials.xlsm").Activate
    ' Range("B65536").End(xlUp).Select
    ' ActiveCell.Offset(1, 1).Activate
    ' ActiveSheet.Paste


    'Copy 3 - Serial 1
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("C19:C22").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    'Copy 3 - Serial 2
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("G19:G22").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    'Copy 3 - Serial 3
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("K19:K22").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    'Copy 3 - Serial 4
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("O19:O22").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    'Copy 4 - Serial 1
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("C27:C30").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    'Copy 4 - Serial 2
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("G27:G30").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste


    'Copy 4 - Serial 3
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("K27:K30").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste

    'Copy 4 - Serial 4
    Workbooks.Open FILENAME:=MyFolder & "\" & MyFile, UpdateLinks:=0
    Sheets("Sheet1").Select
    Range("O27:O30").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWorkbook.Close True
    Windows("All serials.xlsm").Activate
    Range("B65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
    ActiveSheet.Paste
    MyFile = Dir

    Loop

    Application.ScreenUpdating = True

    MsgBox "Import complete"

    End Sub



    It is not pretty but it worked

  5. #5
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,819
    Thanks
    133
    Thanked 480 Times in 457 Posts
    Hi Gabushna

    Top marks for solving your issue.
    It's great when you figure out the solution yourself.
    A great way of learning VBA is to go through the code of others.
    I like to try and document each line of code.
    I have attached an updated version of my file - I tidied it a little bit!

    zeddy
    Attached Files Attached Files
    Last edited by zeddy; 2016-03-03 at 09:34.

  6. The Following User Says Thank You to zeddy For This Useful Post:

    Gabushna (2016-03-08)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •