Consulting

Results 1 to 5 of 5

Thread: Copy and paste loop help

  1. #1
    VBAX Regular
    Joined
    Sep 2016
    Posts
    7
    Location

    Red face Copy and paste loop help

    Hello everyone!

    I am semi-new to VBA and really loving it! I am currently trying to create a macro that will look into a folder, copy columns A:H, of all excel files, and paste them into my master file. The rows will never change, just the number of rows. This one macro could save me 4+hours a week of time wasted just copying and pasting. I found TheSpreadsheetGuru's code and am not able to figure out how to modify it to my specific needs. Can someone help show me where to paste the necessary instructions into the code? Or is there an easier way to get this done? Thanks!

    Sub LoopAllExcelFilesInFolder()
    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
    'SOURCE: TheSpreadsheetGuru

    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

    'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'Retrieve Target Folder Path From User
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
    .Title = "Select A Target Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
    End With

    'In Case of Cancel
    NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings

    'Target File Extension (must include wildcard "*")
    myExtension = "*.xls"

    'Target Path with Ending Extention
    myFile = Dir(myPath & myExtension)

    'Loop through each Excel file in folder
    Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
    DoEvents

    'Change First Worksheet's Background Fill Blue
    wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

    'Save and Close Workbook
    wb.Close SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
    DoEvents

    'Get next file name
    myFile = Dir
    Loop

    'Message Box when tasks are completed
    MsgBox "Task Complete!"

    ResetSettings:
    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    End Sub

  2. #2
    VBAX Expert
    Joined
    May 2016
    Posts
    604
    Location
    After a quick look I have got a comment about this code:
    It only open files with .xls extension:
    [VBa]'Target File Extension (must include wildcard "*")
    myExtension = "*.xls"[/VBA]
    You need to change this .xlsx or .xlx? is you have .xlsm files as well


    The place to put your code is instead of the lines:
    [VBA]Change First Worksheet's Background Fill Blue
    wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)[/VBA]

  3. #3
    VBAX Regular
    Joined
    Sep 2016
    Posts
    7
    Location
    Offthelip, Thank you very much for your help! I am trying to work in a sub that sequentially pastes all of the data from each file. If you have any tips, that would be awesome! I have been doing some research and haven't turned anything up yet!

  4. #4
    VBAX Expert
    Joined
    May 2016
    Posts
    604
    Location
    You need to open the master workbook that you are copy everything to and save the name by setting "master" to it
    You need to keep track of where you are going to write the data from each of the workbooks into the master , do this by setting up an index which increment by 8 ( the number of columns you are coying)
    then within the loop you already have where you open each file in turn you first of all detect how many rows you need to copy using then put the code to copy the data and increment the index.
    you need to know which worksheet the data is coming from .

    [vba]Dim master As Workbook, wb As Workbook
    'open the master workbook first
    Set master = ActiveWorkbook


    '
    'Loop through each Excel file in folder
    Index = 1
    Do While myFile <> ""


    ' select the correct sheet in the workbook
    ' then detect the last row of data with:
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row


    'then copy the data


    master.Worksheets("Sheet1").Range(Cells(1, Index), Cells(lastrow, Index + 7)).Value = wb.Worksheets("Sheet1").Range(cells(1,1),cells(lastrow,8)).Value
    Index = Index + 8



    loop[/vba]

  5. #5
    VBAX Regular
    Joined
    Sep 2016
    Posts
    7
    Location
    You are the bomb! Thank you for explaining this. I will be working it over the next few days, but I think I have a good understanding about what to do!

Tags for this Thread

Posting Permissions

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