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

move data |closed wb --> active wb | sheets = "samename"

M

Mr.Karr

Member
Hi

Is it possible to copy/move data from a closed/open workbook depends on sheet names?
Summary: Intention behind this activity is to help users to comfortably move data from previous tracker file to a new tracker with just a click. Sheet names and ranges are all the same with both the trackers.

Imagine there will a macro button with the previous tracker, when user clicks it following would happen (a finish to start approach)

1. Opens up file explorer (only one file & looping is not required)
2. Start copying a particular range into the match-match sheet names
3. Loops to all the matching sheets and carry on the copy-paste activity
4. Once done, ask users to save the file

Please help
 
@Luke M : this link does helps but yes to some extent.
@NARAYANK991 & I have developed the code further to fit the requirement.
Code: 
Sub ConsolidateSheetsFromWorkbooksUpdated()
    Dim wbSource As Workbook, wbDestination As Workbook
    Dim wsDestination As Worksheet, wsSource As Worksheet
    Dim LR As Long, NR As Long
    Dim fPath As String, fName As String

    Set wbSource = ThisWorkbook    'keeps destination focus on this workbook
                                      'if files are stored in separate directory edit fPath
  fPath = ThisWorkbook.Path & "\"    'don't forget the final \
                                
    fName = Dir(fPath & "*.xls*")        'start looping through files one at a time
  Application.ScreenUpdating = False  'speed up macro
  On Error Resume Next                'allow macro to proceed if sheetname matches are missing

    Do While Len(fName) > 0            'process one workbook at a time
    If fName <> ThisWorkbook.Name Then
          Set wbDestination = Workbooks.Open(fPath & fName)                    'open the next resource workbook
        For Each wsSource In wbSource.Worksheets                              'cycle through the sheets
            Set wsDestination = wbDestination.Sheets(wsSource.Name)          'try to match the sheetnames
            If InStr(1, "Sheet1|Sheet2", wsDestination.Name) > 0 Then        'only proceed if a matching sheetname was found
              NR = wsDestination.Range("A" & Rows.Count).End(xlUp).Row + 1  'next empty row
              With wsSource                                                  'measure the used rows then copy
                    LR = .Range("A" & .Rows.Count).End(xlUp).Row
                      .Range("A21:A" & LR).EntireRow.Copy wsDestination.Range("A" & NR)
                End With
                Set wsDestination = Nothing
              End If
          Next wsSource
    
          wbDestination.Close True
      End If

      fName = Dir                'queue up next filename
  Loop

    Application.ScreenUpdating = True      'update screen, back to normal
  MsgBox "complete"
    Call filesavedialog
End Sub
Above code exactly does what is required but it is pasting data in row#2 but I need it in row#21 ie cell A21.
Also presently the 'save as' dialogue shows up for the 'data' file which is the source but not the destination file.
Can you please help to modify this a bit. Thanks for your time
Please feel free if you need any additional info.
Files attached for your reference
 

Attachments

  • Data.xlsm
    43.4 KB · Views: 0
  • Update.xlsm
    16.3 KB · Views: 0
For the first part, change line 21 to this:
Code: 
NR = wsDestination.Range("A21")  'HARD CODED
Now it's hardcoded to row 21, rather than just picking next blank row.

For your save question, some clarification...do you want to see dialogue for:
a) Destination files only
b) Source file only, Destination gets saved with same name
c) Destination and Source file
d) Neither, save file using existing name
 
@Luke M : code added at line#23
Answering your question:
Destination file only. i.e.
Source file will be kept open and from that file only the macro gets activated. That looks for a particular file in a folder (presently it's like)
Code: 
fPath = ThisWorkbook.Path & "\"
can you please modify this fPath to C:\desktop please
At the end, once the past is done, pls call open the destination file (from fPath) and show the 'save as' dialogue so user can save it in his desktop.
Please note, the destination file remains at fPath as a template and that's the main reason whey we trying to call save as to keep the template as such so other users can access in queue. Hope this answers ur question
 
Here's what you asked for. I think it would be better to have the code automatically save the file with a new name, rather than prompting user each time, but it may be needed I suppose.
Code: 
Sub ConsolidateSheetsFromWorkbooksUpdated()
Dim wbSource As Workbook, wbDestination As Workbook
Dim wsDestination As Worksheet, wsSource As Worksheet
Dim LR As Long, NR As Long
Dim fPath As String, fName As String

Set wbSource = ThisWorkbook    'keeps destination focus on this workbook
                               'if files are stored in separate directory edit fPath
fPath = "C:\Desktop\"  'don't forget the final \
                         
fName = Dir(fPath & "*.xls*")        'start looping through files one at a time
Application.ScreenUpdating = False  'speed up macro
On Error Resume Next                'allow macro to proceed if sheetname matches are missing

Do While Len(fName) > 0            'process one workbook at a time
    If fName <> ThisWorkbook.Name Then
        Set wbDestination = Workbooks.Open(fPath & fName)                    'open the next resource workbook
        For Each wsSource In wbSource.Worksheets                              'cycle through the sheets
            Set wsDestination = wbDestination.Sheets(wsSource.Name)          'try to match the sheetnames
            If InStr(1, "Sheet1|Sheet2", wsDestination.Name) > 0 Then        'only proceed if a matching sheetname was found
                NR = wsDestination.Range("A21")  'HARD CODED
                With wsSource                                                  'measure the used rows then copy
                    LR = .Range("A" & .Rows.Count).End(xlUp).Row
                    .Range("A21:A" & LR).EntireRow.Copy wsDestination.Range("A" & NR)
                End With
                Set wsDestination = Nothing
            End If
        Next wsSource
        'Not sure you really want to do this for every file, but ok...
        Call filesavedialog
        wbDestination.Close False 'If user chose not to save, close anyway
    End If
   
    fName = Dir                'queue up next filename
Loop

Application.ScreenUpdating = True      'update screen, back to normal
MsgBox "complete"

End Sub
 
Can we include the below snippet if we try opening the destination file from a particular location? Please advise
Code: 
Workbooks.Open ("C:\Users\v-kart\Desktop\New folder (2)\Update.xlsm")
 
I'm not sure what you mean. User isn't give option of choosing which files to open, it simply opens every XL file in folder hard coded, atm.
 
@Luke M : data is not getting copied into destination file. Should I need to save both the files in same location?
Apart from that, it opens up save as dialogue box & saves an empty template. Please advise
 
destination file is going to be only one file, fyi.
But it does have some display alerts & open module userform forms. Will it affect the process?
(now we are testing with sample file without them, in case)
 
I'm confused now. Your code that you posted loops through several destination workbooks, and copies info from a single source (the workbook you're running code from) to each destination book. This doesn't seem to be what you are actually doing...
How many source workbooks are there?
How many destination workbooks are there?
Where is the macro to be stored (source or destination)?
 
Sorry about that.
Source workbook = 1 i.e. Data.xlsm
Destination workbook = 1 i.e. Update.xlsm

Macro is in Data.xlsm file. Once user clicks on it, the automation has to open up the update.xlsm file, copies data and show 'save as' dialogue box

Please let me know if you need any info. Here are the files
 

Attachments

  • Update.xlsm
    10.1 KB · Views: 2
  • Data.xlsm
    41.6 KB · Views: 1
Ah, that helps clarify things. How's this then? Note that the file path for Update sheet is hardcoded.
 

Attachments

  • Data LM.xlsm
    37.2 KB · Views: 3
@Luke M that works like a breeze. But there are few yet
1. Data is getting pasted randomly in the update.xlsm file. But we have a fix. Imagine we already have some labels there at A20, will this help to paste data in the next empty cell?
2. With the matching names across sheets, there will be few sheets alike in particular. Say sheet1 to sheet5 (but name differs in master file). Can you please fix this with array.
3. In the update.xlsm, there will be userform & welcome msgbox, will this affect the process? If yes, can we insert displayalerts = false ?

Other than that, this is awesome! Please advise
 
1. You said you wanted all the data pasted into row 21, all the time. Is that no longer true and it needs to be first blank cell after row 20?
2. Are we copying data at a 1-to-1 in terms of sheets, or do some sheets get copied to multiple other sheets? We could set up a Select Case I suppose, where Sheet1 goes to Sheet1, and Sheet2 goes to Sheet5, if a 1-to-1.
3. How is the user form being called? If it's on a workbook_open event, then need to add some
Code: 
'Turns off the event macros
Application.EnableEvents = False
'do regular macro here
Application.EnableEvents = True
 
Thanks for the snippet. I've included that.
To answer your question, I'm parallely exploring ways, checking if we tweak concept a bit here & there.
2. yes, 1 to 1 basis but sheet1 to sheet1, sheet2 to sheet2, cat to cat, panda to panda :)
3. yes, userform and welcome msgbox are there in workbook_open event.
Will turning off events will help ? Please advise
 
2. In that case, I'm not sure what the question was.o_O
3. Correct, if events are off, then the Workbook_Open event won't get called, and user should see anything.
 
alright Luke. If you can help modify this part would be great. 5 sheets in total. Sheet1 to sheet5. Macro should copy data from these sheets only.
Code: 
 If .Name <> "Home" Then
                'Check if sheet exists
                Set wsDest = Nothing
                On Error Resume Next
                Set wsDest = wbDest.Worksheets(.Name)
Thanks a bunch!
 
I don't know how I can modify that...the code goes through every worksheet except for the Home sheet. Are there a bunch of sheets within Data book that have same name in Update book that you don't want copied over?
 
Gotcha. Something similar, we'll use a Select and you can list out any sheets you want to ignore. Full macro:
Code: 
Sub ConsolidateSheetsFromWorkbooksNew()
    Dim wbSource As Workbook, wbDest As Workbook
    Dim wsSource As Worksheet, wsDest As Worksheet
   
    Dim LR As Long
    Dim fPath As String
   
    'Where is the file of interest?
    fPath = "C:\Users\v-kart\Desktop\New folder (2)\Update.xlsm"

    Set wbSource = ThisWorkbook
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set wbDest = Workbooks.Open(fPath)

   
    For Each wsSource In wbSource.Worksheets
        With wsSource
            Select Case .Name
            Case "Home", "Data"
                'Do nothing, ignore these sheets
            Case Else
                'Check if sheet exists
                Set wsDest = Nothing
                On Error Resume Next
                Set wsDest = wbDest.Worksheets(.Name)
                On Error GoTo 0
                If Not wsDest Is Nothing Then
                    LR = .Range("A" & .Rows.Count).End(xlUp).Row
                    .Range("A2:A" & LR).EntireRow.Copy wsDest.Range("A21")
                End If
            End Select
        End With
    Next wsSource
   
    'Save As will happen to the active workbook
    wbDest.Activate
    Application.Dialogs(xlDialogSaveAs).Show
    wbDest.Close
    Application.EnableEvents = True
    Application.ScreenUpdating = True

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