• 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.

How to copy data from 1 workbook to other workbook based on some criteria

A

Akash kothari

Member
Hello Friends,

I have created one small macro which copy data from main file to other sub file based on column E named as "CRM"
within subfiles you can find these CRM as sheets names.
I did it for 1 CRM but how to do the same for multilple CRM in different workbook.
Can anyone advise please

Thank you
Akash

Code that i created (attached the files)

Sub Button1_Click()
lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Cells(i, 5) = "Catherine Mclaughlin" Then
Range(Cells(i, 1), Cells(i, 10)).Select
Selection.Copy
Workbooks.Open Filename:="C:\Documents and Settings\e560228\Desktop\New Folder\New Folder\CRM\20131014 - CRM Event Log- London.xlsx"
Dim p As Integer, q As Integer
p = Worksheets.Count
For q = 1 To p
If ActiveWorkbook.Worksheets(q).Name = "Catherine Mclaughlin" Then
Worksheets("Catherine Mclaughlin").Select
End If
Next q
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub
 

Attachments

  • Ops Event Log Main File.xlsm
    24.1 KB · Views: 5
  • 20130113- CRM Event log London.xlsx
    10.3 KB · Views: 5
  • 20130113- CRM Event log - Dubai.xlsx
    9.6 KB · Views: 8
Hi Akash,

I have tidied up the code a little and introduced some new ideas for you. The code should do as you require (workbook attached) but you might also find some value in stepping through the code and seeing how it works.

Code: 
Sub RunReport()

Dim iLastDataRow As Long, iLastOutputRow As Long
Dim i As Long
Dim sName As String
Dim vaData As Variant

Dim wkbCRM_Log As Workbook
Dim wsReport As Worksheet, wsLog As Worksheet

'Turn display alerts off so the VBA can run through
'opening and closing workbooks without prompts
Application.DisplayAlerts = False

'When working across multiple workbooks / worksheets it is usually
'easier (and more efficient) to set a variable than select
Set wsReport = ThisWorkbook.Sheets("Reports")

With wsReport
  iLastDataRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With

'Open the Workbook which is used for reporting
Set wkbCRM_Log = Workbooks.Open(Filename:="C:\Temp\Excel\CRM\20130113- CRM Event log London.xlsx")
   
   
'Loop through each CRM (column E) cell in the data list
For i = 2 To iLastDataRow

  'Extract the CRM name (this will be used later)
  sName = wsReport.Cells(i, 5)

  'Only proceed if there is a name (ie the length of the name is greater than zero
  If Len(sName) > 0 Then
    'Declare a variant array variable to hold the contents for this person
    'This means we do not need to use copy / paste
    With wsReport
      vaData = Range(.Cells(i, 1), .Cells(i, 10))
    End With
   
    'We use error trapping to identify if there is a worksheet by this name
    'If there is not then it is added (see ErrAddSheet: below)
    On Error GoTo ErrAddSheet
      Set wsLog = wkbCRM_Log.Worksheets(sName)
   
    With wsLog
      iLastOutputRow = .Cells(.Rows.Count, 5).End(xlUp).Offset(1, 0).Row
     
      'Write the data (from the variant array) to the output worksheet
      .Cells(iLastOutputRow, 1).Resize(1, 10) = vaData
    End With
    Set wsLog = Nothing
  End If

Next i


'Error handling for when a new worksheet needs to be added
ErrAddSheet:
      If Err.Number > 0 Then
        Set wsLog = wkbCRM_Log.Worksheets("Others")
        'wsLog.Name = sName
        Err.Clear
        Resume Next
      End If

'Clean up
Set wsLog = Nothing
wkbCRM_Log.Close True
Application.DisplayAlerts = True
Set wsReport = Nothing
Set wkbCRM_Log = Nothing

End Sub

Thanks,

Peter
 

Attachments

  • Ops Event Log Main File.xlsm
    26.5 KB · Views: 7
Hi Peter,

First Thank you for your Reply,

The above code is not working for me, May be i need to be more clear on what i am looking for.

I copy data from the main file Ops Event Log to the CRM Event log Dubai, London ,paris singapore Etc. I have total of 8 such location (8 different Excel files) and each location have Different CRM's names (as sheet name) which we find in the Main file.
In the main file I filter for the CRM location Column D and then for CRM's column E in that location and copy and paste data into respective Event Log file under That CRM sheet.

No CRM's handles is more than 1 location. that means we don't find same CRM in any other location.

I am new into this please correct me if i am wrong.

Thank you
Akash
 
Hi Akash,

My apologies, I mis-understood your need to use different workbooks for each location. With that in mind, please make sure that the filename structure for each location is identical. (I.e. At the moment you have an extra - in the filename for Dubai. This will need to be removed.

After that, the following code should work (file attached).

Code: 
Sub RunReport()

Dim iLastDataRow As Long, iLastOutputRow As Long
Dim i As Long
Dim sName As String, sLocation As String
Dim sFileName As String
Dim vaData As Variant

Dim wkbCRM_Log As Workbook
Dim wsReport As Worksheet, wsLog As Worksheet

'Turn display alerts off so the VBA can run through
'opening and closing workbooks without prompts
Application.DisplayAlerts = False

'When working across multiple workbooks / worksheets it is usually
'easier (and more efficient) to set a variable than select
Set wsReport = ThisWorkbook.Sheets("Reports")

With wsReport
  iLastDataRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With

   
'Loop through each CRM (column E) cell in the data list
For i = 2 To iLastDataRow

  'Extract the CRM name (this will be used later)
  sName = wsReport.Cells(i, 5).Value
  sLocation = wsReport.Cells(i, 4).Value
  If Len(sLocation) = 0 Then Exit Sub
  'Only proceed if there is a name (ie the length of the name is greater than zero
  If Len(sName) > 0 Then
    'Declare a variant array variable to hold the contents for this person
    'This means we do not need to use copy / paste
    With wsReport
      vaData = Range(.Cells(i, 1), .Cells(i, 10))
    End With
   
    'Open the Workbook which is used for reporting
    sFileName = "C:\Temp\Excel\CRM\20130113- CRM Event log " & sLocation & ".xlsx"
    Set wkbCRM_Log = Workbooks.Open(Filename:=sFileName)
   
    'We use error trapping to identify if there is a worksheet by this name
    'If there is not then it is added (see ErrAddSheet: below)
    On Error GoTo ErrAddSheet
      Set wsLog = wkbCRM_Log.Worksheets(sName)
   
    With wsLog
      iLastOutputRow = .Cells(.Rows.Count, 5).End(xlUp).Offset(1, 0).Row
     
      'Write the data (from the variant array) to the output worksheet
      .Cells(iLastOutputRow, 1).Resize(1, 10) = vaData
    End With
   
    Set wsLog = Nothing
    wkbCRM_Log.Close True
  End If

Next i


'Error handling for when a new worksheet needs to be added
ErrAddSheet:
      If Err.Number > 0 Then
        Set wsLog = wkbCRM_Log.Worksheets("Others")
        Err.Clear
        Resume Next
      End If

'Clean up
Set wsLog = Nothing
Application.DisplayAlerts = True
Set wsReport = Nothing
Set wkbCRM_Log = Nothing

End Sub

Thanks,

Peter
 

Attachments

  • Ops Event Log Main File.xlsm
    26.8 KB · Views: 9
Hi Peter,

Awesome that is working perfect :) Thank you
(Your comment really helped me to understand the codes thankyou for putting them with the codes)

Just the last thing, I want to remove old data from all the files and from all the sheets from Cells A2 and format the data in a Table format with "All Borders".

Thank you
Akash
 
Hi Akash,

Do you mean that you want to do this as a one off exercise or every time, before the macro is run?

Regards,

Peter
 
Yes Peter, Every time before i run the macro (use new data) and once location sheets are blank after that formating the New data as "All borders"
(want to keep headers same and delete data From 2nd Row and below)
 
Hi Akash,

I have updated the workbook and added a new section to the code (marked with ' -------------) together with 2 new sub routines.

Regards,

Peter
 

Attachments

  • Ops Event Log Main File.xlsm
    31.2 KB · Views: 9
Hi Peter,

I am getting the compile Error in the below part. Can you please help me What is wrong here?

'Create dictionary of unique locations
Set dctLocations = New Scripting.dictionary

Attached screenshot

Thank you
Akash
 

Attachments

  • Compile Error.JPG
    Compile Error.JPG
    37.1 KB · Views: 2
Hi Akash,

In your VB editor please can you select:
  • Tools
  • References
  • [Tick] Microsoft Scripting Runtime (you might need to scroll down to find it)
  • [OK]

Then re-run the Macro.

Regards,

Peter
 
You must log in or register to reply here.
Back
Top