Macro or VBA code to open many files, copy text, close file, paste text in second workbook

[Bikeman]

I have many excel file that I need to open and copy one number, 12 names and 12 dates. Then paste this text into a second wookbook. I have a lot of files and hope their is a way to automatically open each file and auto populate to second workbook, close file and open the next.

Sorry my first post, hope I'm giving enough info.
Any help would be greatly appreciated

[jo15765]

In the 2nd workbook, let's call it "Master" for examples sake...where does the data that is being copied need to be pasted? Also in the workbooks that are being copied from, is it always the same range that is being copied or does it vary?

[jolivanes]

Something like this?


http://www.excelforum.com/excel-prog...workbooks.html

[Bikeman]

The second workbook or master the info is being pasted across columns, the number under A column a name under B, date under C and keeps going with 11 more names and dates. Then down to next line with the next workbook and so on. The info being copied from the workbooks is always in the same range.

[jolivanes]

Did you try the example in post #3?

Sub cons_data()

Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Application.ScreenUpdating = False
'The folder containing the files to be recap'd
myPath = "C:\TempA"    '<----- Change to folder where files are
'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xls")

'Create a workbook for the recap report
Set Master = ThisWorkbook

Do
    Workbooks.Open (myPath & "\" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    Set sourceData = sourceBook.Worksheets(1)
    
        With sourceData
            .Range("A1:C12").Copy    '<----- Range to be copied. Change if required            
            Master.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
        End With
       
    sourceBook.Close
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""
Application.ScreenUpdating = True
End Sub

[Bikeman]

I did try your post 3 and it worked up to opening the first file but then had an issue (something I changed). Below is what I changed your code to and it had an issue with the second line under "With sourceData. It opened the first file and cell


Sub Cons_data()

Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Application.ScreenUpdating = False
'the files contain data to be compiled
myPath = "C:\Documents and Settings\jnm0128\My Documents\TEST PCN's"

CurrentFileName = Dir(myPath & "\*12345.xlsx")

'Create a workbook for the pcn report
Set Master = ThisWorkbook

Do
Workbooks.Open (myPath & "\" & CurrentFileName)
Set sourceBook = Workbooks(CurrentFileName)
Set sourceData = sourceBook.Worksheets(1)

With sourceData
.Range("EM1").Copy
Master.Worksheets(1).Range("A3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("J7").Copy
Master.Worksheets(1).Range("B3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("J8").Copy
Master.Worksheets(1).Range("C3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("V7").Copy
Master.Worksheets(1).Range("D3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("V8").Copy
Master.Worksheets(1).Range("E3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("AH7").Copy
Master.Worksheets(1).Range("F3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("AH8").Copy
Master.Worksheets(1).Range("G3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("AT7").Copy
Master.Worksheets(1).Range("H3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("AT8").Copy
Master.Worksheets(1).Range("I3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("BF7").Copy
Master.Worksheets(1).Range("J3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("BF8").Copy
Master.Worksheets(1).Range("K3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("BR7").Copy
Master.Worksheets(1).Range("L3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("BR8").Copy
Master.Worksheets(1).Range("M3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("CD7").Copy
Master.Worksheets(1).Range("N3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("CD8").Copy
Master.Worksheets(1).Range("O" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("CP7").Copy
Master.Worksheets(1).Range("P" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("CP8").Copy
Master.Worksheets(1).Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("DB7").Copy
Master.Worksheets(1).Range("R" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("DB8").Copy
Master.Worksheets(1).Range("S" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("DN7").Copy
Master.Worksheets(1).Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("DN8").Copy
Master.Worksheets(1).Range("U" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("DZ7").Copy
Master.Worksheets(1).Range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("DZ8").Copy
Master.Worksheets(1).Range("W" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("EL7").Copy
Master.Worksheets(1).Range("X" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
.Range("EL8").Copy
Master.Worksheets(1).Range("Y" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With

sourceBook.Close

CurrentFileName = Dir()
Loop While CurrentFileName <> ""
Application.ScreenUpdating = True
End Sub

[jolivanes]

You have to qualify where to paste to.

There must be an easier and better way but in the meantime try this

Sub Cons_data_B()

Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim myPath As String
Application.ScreenUpdating = False
'the files contain data to be compiled
myPath = "C:\TempA"     "<------ Change as required

CurrentFileName = Dir(myPath & "\*.xls")

'Create a workbook for the pcn report
Set Master = ThisWorkbook

Do
Workbooks.Open (myPath & "\" & CurrentFileName)
Set sourceBook = Workbooks(CurrentFileName)
Set sourceData = sourceBook.Worksheets(1)

With sourceData
.Range("EM1").Copy
With Master.Worksheets(1)
.Range("A3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("J7").Copy
With Master.Worksheets(1)
.Range("B3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("J8").Copy
With Master.Worksheets(1)
.Range("C3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("V7").Copy
With Master.Worksheets(1)
.Range("D3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("V8").Copy
With Master.Worksheets(1)
.Range("E3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("AH7").Copy
With Master.Worksheets(1)
.Range("F3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("AH8").Copy
With Master.Worksheets(1)
.Range("G3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("AT7").Copy
With Master.Worksheets(1)
.Range("H3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("AT8").Copy
With Master.Worksheets(1)
.Range("I3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("BF7").Copy
With Master.Worksheets(1)
.Range("J3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("BF8").Copy
With Master.Worksheets(1)
.Range("K3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("BR7").Copy
With Master.Worksheets(1)
.Range("L3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("BR8").Copy
With Master.Worksheets(1)
.Range("M3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("CD7").Copy
With Master.Worksheets(1)
.Range("N3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("CD8").Copy
With Master.Worksheets(1)
.Range("O" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("CP7").Copy
With Master.Worksheets(1)
.Range("P" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("CP8").Copy
With Master.Worksheets(1)
.Range("Q" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("DB7").Copy
With Master.Worksheets(1)
.Range("R" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("DB8").Copy
With Master.Worksheets(1)
.Range("S" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("DN7").Copy
With Master.Worksheets(1)
.Range("T" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("DN8").Copy
With Master.Worksheets(1)
.Range("U" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("DZ7").Copy
With Master.Worksheets(1)
.Range("V" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("DZ8").Copy
With Master.Worksheets(1)
.Range("W" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("EL7").Copy
With Master.Worksheets(1)
.Range("X" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
.Range("EL8").Copy
With Master.Worksheets(1)
.Range("Y" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End With
End With

sourceBook.Close

CurrentFileName = Dir()
Loop While CurrentFileName <> ""
Application.ScreenUpdating = True
End Sub

[Bikeman]

Same thing happens, when it get to this line in the code it has an error. .Range("A3" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues).

When I run it I get a (Run-time error '1004' Application-defined or object-defined error) when i select the "Debug" button it opens the file I'm trying to copy the data from and also highlights to line above.

Other than adding the folder destination under mypath in your code, is there anything else in the code I should be changing before trying it?

[Bikeman]

jolivanes,
Would it help if I attached the two files in question? If so how can I attach them so you can take a look. I do not see any tool to allow me to attach files.

[jolivanes]

Click on the Go Advanced button and Manage Attachments. Upload the files in question and attach.
Good luck

John

[Bikeman]

John,

I attched one copy of the file I'm trying to take info from (see PCN Form.xlsx in yellow) with the 1 PCN number up in the top right I'm trying to copy to master sheet A3, then there are 12 places (in Yellow) that individuals need to add thier name and 12 places to add date. Note: these names and dates are in merged cells. There are many of these files and the file names all start with a # like (28035PCN.xls).

The "Master Date Data" file is where I'm trying to copy the info to. The PCN Number to A3, Intiator signature and date to B3 and C3 and Engineer signature and date to D3 and E3 and so on.

Then close file and open next.

Thanks so much for your help.

[jolivanes]

Bikeman
Try this and see what happens.

I think you should re-design, if possible, your workbooks because merged cells can be a problem to work with in code.

Sub Cons_data_D()

    Dim Master As Workbook
    Dim sourceBook As Workbook
    Dim sourceData As Worksheet
    Dim CurrentFileName As String
    Dim myPath As String
    Application.ScreenUpdating = False
    'the files contain data to be compiled
    myPath = "C:\Bikeman"

    CurrentFileName = Dir(myPath & "\*.xlsx")

    'Create a workbook for the pcn report
    Set Master = ThisWorkbook

    Do
        Workbooks.Open (myPath & "\" & CurrentFileName)
        Set sourceBook = Workbooks(CurrentFileName)
        Set sourceData = sourceBook.Worksheets(1)

        With sourceData
            .Range("EM1").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("J7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("J8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "C").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("V7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("V8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "E").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("AH7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "F").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("AH8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "G").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("AT7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "H").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("AT8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "I").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("BF7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "J").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("BF8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "K").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("BR7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "L").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("BR8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "M").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("CD7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "N").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("CD8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "O").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("CP7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "P").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("CP8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "Q").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("DB7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "R").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("DB8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "S").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("DN7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "T").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("DN8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "U").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("DZ7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "V").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("DZ8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "W").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("EL7").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "X").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
            .Range("EL8").Copy
            With Master.Worksheets(1)
                .Cells(.Rows.Count, "Y").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
            End With
        End With

        sourceBook.Close

        CurrentFileName = Dir()
    Loop While CurrentFileName <> ""
    Application.ScreenUpdating = True
End Sub

[Bikeman]

John,
Thanks this did work! It has a couple of issues but I think you are right, I need to re-design the workbooks like you suggested. I had the feeling the merged cells were going to be an issue.

I will work on new workbooks before going any further.

Thanks again for you help.

[jolivanes]

Serious issues or manageable issues?

Like I said previously, there must be code that is shorter/better and I was hoping someone with that kind of skill would jump in but for now it works you said.

Good luck.

John