Copy data from a list of workbooks to another master workbook

[Viper147]

Hi everyone,

Once again I find myself in a bind and need some help please. As mentioned before I am still a noob with VBA so be gentle.
I have a list of workbooks in a range in Excel that I need to copy data from and paste it in a single worksheet (all new data to be appended at the bottom of the previous data set that was copied). I managed to get the bulk of the code right to open the source books and copy the data, but cannot get it right to paste the data in the next empty cell in the target book.
My apologies for the messy code as this has become an abortion of different codes that I have pieced together over the past few days. "a" refers to row nr 1 where the first file location is popuated. The code is then supposed to cycle through the list in column R till it gets to the first empty cell.
The last bit of the code is to compile a list of files that were not found in the relevant folder which will pop up in the end in a messagebox to warn the user of the missing files. As always thanks in advance for the help. See below:

Sub Test2()
'
' Test2 Macro
'
Dim MyBook As Workbook
Dim OtherBook As Workbook
Dim a As Integer
Dim msg As String
 
a = 1
Set MyBook = ActiveWorkbook
 
Do Until Range("R" & a) = ""
Set OtherBook = Workbooks.Open(Filename:=Range("R" & a))
If OtherBook Is Nothing Then msg = msg & Range("R" & a) Else
OtherBook.Sheets("Data").Range("A2:CN" & Range("Lines")).Copy
MyBook.Sheets("Data").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
OtherBook.Close False
 
a = a + 1
Loop
 
If Len(msg) Then
        MsgBox "Not found" & msg
End If
 
'
End Sub

 

[Fluff]

Try replacing

MyBook.Sheets("Data").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

with

myBook.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues

 

[Viper147]

Thanks for responding Fluff and fixing up the posting of my code, still something I can't get right.
I made the change you suggested and it fixed the pasting routine. However it does not loop and open the rest of the files. I have 3 files at the moment to test the process of which only the first file opens and then the code stops. See below the code as it is now:

[FONT=Calibri][SIZE=3][COLOR=#000000]Sub Test2()[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]' Test2 Macro[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim MyBook As Workbook[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim OtherBook As Workbook[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim a As Integer[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim msg As String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]a = 1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Set MyBook = ActiveWorkbook[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Do Until Range("R" & a) = ""[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Set OtherBook = Workbooks.Open(Filename:=Range("R"& a))[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]If OtherBook Is Nothing Then msg = msg &Range("S" & a) Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]OtherBook.Sheets("Data").Range("A2:CN"& Range("Lines")).Copy[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]MyBook.Sheets("Data").Range("A" &Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Application.CutCopyMode = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]OtherBook.Close False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]a = a + 1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Loop[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]If Len(msg) Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox"Not found" & msg[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

 

[Fluff]

Try

Sub Test2()
'
' Test2 Macro
'
Dim MyBook As Workbook
Dim OtherBook As Workbook
Dim a As Integer
Dim msg As String

a = 1
Set MyBook = ActiveWorkbook

Do Until Range("R" & a) = ""
   On Error Resume Next
   Set OtherBook = Workbooks.Open(fileName:=Range("R" & a))
   On Error GoTo 0
   If OtherBook Is Nothing Then
      msg = msg & Range("S" & a)
   Else
      OtherBook.Sheets("Data").Range("A2:CN" & Range("Lines")).Copy
      MyBook.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Application.CutCopyMode = False
      OtherBook.Close False
      a = a + 1
   End If
Loop

If Len(msg) Then MsgBox "Not found" & msg


'
End Sub

 

[Viper147]

Hi there, thanks for the post. Tried the amended code but it still only copies the data from the first file in the list and then stops.

 

[Fluff]

Try

Do Until MyBook.Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("R" & a) = ""
On Error Resume Next
   Set OtherBook = Workbooks.Open(fileName:=MyBook.Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("R" & a))
   On Error GoTo 0

Change the sheet name to suit.

 

[Viper147]

Thanks for the help and patience. Tried the amended piece of code, the macro just runs but does not perform any noticeable actions.

 

[Fluff]

OK, try stepping through the code using F8. Do the various workbooks open ?

 

[Viper147]

Hi there. Checked the code and picked an error in the sheet name (my fault sorry). Fixed it and everthing runs perfect, except for when I remove one of the files from the folder. In which case it is supposed to compile a list of the missing file names and provide a msgbox at the end with the list of missing file names.
Thanks for all your help thus far, really appreciate it.

 

[Fluff]

What is in Col S

 msg = msg & Range("S" & a)

or should that be col R