• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copying Data from Multiple Worksheets into a Master

N

NATALIE1979

New Member
Hi there
This is my first post as I really need some help with VBA in Excel.
I have created a dashboard, with a macro attached (code below) which will get a list of names of files in a directory, then one by one open the file, copy data from each of the 3 tabs and paste them into a new master file.

The first run through works fine, but then loops through gets to here:
Code: 
' OPENS XLCRM DATABASES TO BE BUILD INTO A MASTER FILE STARTING WITH COPYING OF CUSTOMERS FROM CELL A TO N
Workbooks.Open FileName:=GetFilesFrom & FilenameImport
Sheets("Customers").Select
Range("A2:N2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection.End(xlToRight), Selection.End(xlDown)).Copy
Application.CutCopyMode = False
Selection.Copy

then goes to C4 on the masterfile (which is a date field) and thinks it needs to open that as a file and returns an error saying cannot find 11/01/2013.xlsm , instead of getting the next filename from C4 on the file I created to build the master file.


Code: 
Sub Build()

  Dim EmployeeId As String
  Dim TemplateName As String
  Dim GetFilesFrom As String
  Dim TemplateFolder As String
  Dim BuildLocation As String
  Dim CustomersImport As String
  Dim ContactsImport As String
  Dim FilenameImport As String
  Dim TOTImport As String
  Dim ThisFilename As String
  Dim SaveBuiltDBFilename As String
  Dim LastRow As Long
 
' OPENS UP BULKFILECREATOR CHECKS FILENAMES AND WORKS THROUGH EACH ONE
  Range("J1").Select
  Range("C4").Value = ActiveCell.Value
  GoTo Next_Record
 
  Do
  If ActiveCell = Range("C4").Value Then
  ActiveCell.Offset(1, 0).Select
  Range("C4").Value = ActiveCell.Value
  End If

Next_Record:
  If ActiveCell.Value = "" Then
 
  Dim MsgDone As String
  MsgDone = "Bulk Database Has Now Finished."
  MsgDone = MsgDone & vbNewLine & vbNewLine & "Please check files in the Bulk Database folder."
  MsgBox (MsgDone)
 
  Exit Sub
  End If
 
  ' VARIABLES
  FilenameImport = Range("C4")
  TemplateName = Range("C5")
  TemplateFolder = Range("C6")
  BuildLocation = Range("C7")
  ThisFilename = Range("C8")
  GetFilesFrom = Range("C9")
  SaveBuiltDBFilename = Range("C10")
 
 
  Dim CustomersCount As Integer
  CustomersCount = 1
'  OPENS XLCRM DATABASES TO BE BUILD INTO A MASTER FILE STARTING WITH COPYING OF CUSTOMERS FROM CELL A TO N
  Workbooks.Open FileName:=GetFilesFrom & FilenameImport
  Sheets("Customers").Select
  Range("A2:N2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection.End(xlToRight), Selection.End(xlDown)).Copy
  Application.CutCopyMode = False
  Selection.Copy

  Workbooks.Open FileName:=TemplateFolder & TemplateName
  Sheets("Customers").Select
  Range("A2").Select
  If ActiveCell.Value = "" Then
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
 
  ElseIf Not IsEmpty(ActiveCell.Value) Then
  Range("A1").End(xlDown).Offset(1, 0).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  End If
 
  '  COPIES FORMULA OVER IN CELL M & N
  Windows(FilenameImport).Activate
  Sheets("Customers").Select
  Range("M2:N2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection.End(xlToRight), Selection.End(xlDown)).Copy
  Application.CutCopyMode = False
  Selection.Copy
 
  Windows(TemplateName).Activate
  Sheets("Customers").Select
  Range("M2:N2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
  SkipBlanks:=False, Transpose:=False
  Columns("M:N").Select
  Selection.EntireColumn.Hidden = True
 
  '  COPIES CUSTOMERS DATA FROM COLUMN O TO AR AND PASTES INTO MASTER FILE
 
  'Windows(FilenameImport).Activate
  ' Sheets("Customers").Select
  ' Range("O2:AR2").Select
  ' Range(Selection, Selection.End(xlDown)).Select
  ' Range(Selection.End(xlToRight), Selection.End(xlDown)).Copy
  ' Application.CutCopyMode = False
  ' Selection.Copy

  ' Windows(TemplateName).Activate
  ' Sheets("Customers").Select
  ' Range("A2").Select
  ' If ActiveCell.Value = "" Then
 
  '  COPIES FORMULA OVER IN CELL AS
 
  Windows(FilenameImport).Activate
  Sheets("Customers").Select
  Range("AS2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection.End(xlToRight), Selection.End(xlDown)).Copy
  Application.CutCopyMode = False
  Selection.Copy
 
  Windows(TemplateName).Activate
  Sheets("Customers").Select
  Range("AS2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
  SkipBlanks:=False, Transpose:=False
  Columns("AS").Select
  Selection.EntireColumn.Hidden = True
'  COPIES CONTACTS DATA FROM XLCRM DATABASES TO BE BUILD INTO A MASTER FILE
  Windows(FilenameImport).Activate
  Sheets("Contacts").Select
  Range("A2:N2").Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Copy
 
  Windows(TemplateName).Activate
  Sheets("Contacts").Select
  Range("A2").Select
  If ActiveCell.Value = "" Then
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
 
 
  ElseIf Not IsEmpty(ActiveCell.Value) Then
  Range("A2").End(xlDown).Offset(1, 0).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  End If
 
  '  COPIES TIME OFF-TERRITORY DATA FROM XLCRM DATABASES TO BE BUILD INTO A MASTER FILE
  Windows(FilenameImport).Activate
  Sheets("Time Off-Territory").Select
  Range("A4:J4").Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Copy
 
  Windows(TemplateName).Activate
  Sheets("Time Off-Territory").Select
  Range("A4").Select
  If ActiveCell.Value = "" Then
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
 
 
  ElseIf Not IsEmpty(ActiveCell.Value) Then
  Range("A3").End(xlDown).Offset(1, 0).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  End If
 
  '  CLOSES FILES
  Windows(FilenameImport).Activate
  ActiveWindow.Close SaveChanges:=False
  Application.DisplayAlerts = False
 
Loop
  End Sub
 
Last edited by a moderator:
I would suggest using some parent variables/objects to keep track of which book you are looking at. You can do that like:
Code: 
Dim sourceWB as Workbook
Dim tempWB as Workbook
Set sourceWB = Workbooks.Open(Filename:=GetFilesFrom & FilenameImport)

'Copy all the data in A:N w/o having to select anything in between
With sourceWB.Worksheets("Customer")
     .Range("A2",.cells(.Rows.Count,"N").End(xlUp)).Copy
End With

'Paste somewhere
Workbooks.Open Filename:=TemplateFolder & TemplateName
With Sheets("Customers")
    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End With

W/o debugging the whole code, my guess is that you need to open one of your workbooks outside of the loop so that you don't keep opening it on every loop. Also, we wary of defining (Dim) variables within loops...doing so causes XL to have to re-define the variable every loop, which is not needed.
 
You must log in or register to reply here.
Back
Top