Macro that copies a tab from another workbook and once data is populated gets deleted.

Hello,
Need help in making a little change to the existing Macro. I have a workbook named ABC and the macro populates the data in the  Tab named "Log". I want is the Tab "Log" should now be present in workbook "XYZ" and once I run the macro, the tab log should go to the workbook ABC and once the data is populated it should be deleted from the  workbook ABC and copied back to the workbook XYZ. I will be running macro from the workbook XYZ.

Any help would be extremely helpful. I am going to keep both XYZ and ABC in the same folder. That would help in decreasing the setting path confusion.


Option Explicit

Sub getdata()
    Dim ws1 As Worksheet, ws As Worksheet
    Dim lrow As Long, cell As Range, rng As Range
    Dim lr As Long
    Set ws1 = Sheets("Log")

    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lr > 2 Then ws1.Range("A3:E" & lr).Clear

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ws1.Name Then
            lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lrow > 5 Then
                Set rng = ws.Range("J6:J" & lrow)

                For Each cell In rng

                    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

                    'If UCase(Trim(cell.Value)) = "YES" Then'
                        ws1.Range("A" & lr).Value = Application.WorksheetFunction.Max(ws1.Range("a:a")) + 1
                        ws1.Range("b" & lr).Value = ws.Range("G" & cell.Row).Value
                        ws1.Range("C" & lr).Value = ws.Range("D" & cell.Row).Value
                        ws1.Range("D" & lr).Value = ws.Range("F" & cell.Row).Value
                        ws1.Range("E" & lr).Value = ws.Range("E" & cell.Row).Value
                    'End If'


                Next cell

            End If
        End If

    Next ws

End Sub
Milind AgarwalAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saurabh Singh TeotiaCommented:
Can you post your sample file so that i can look into this and tweak the code for you..

Saurabh...
0
Milind AgarwalAuthor Commented:
Hey Saurabh,
Please find the attached spreadsheet. U could see the tab log is present in the spreadsheet attached.  I wanted this tab to come from different workbook Say Workbook B and once we run the macro the tab Log gets copied to Workbook A since it contains all the data to be copied into this tab. Once the data is copied it gets deleted from this workbook A and pasted back in Workbook B.

Thanks,
Milind
WorkbookA-1.xlsm
0
Saurabh Singh TeotiaCommented:
I'm not sure Milind i follow you here..this is what i understood..

1. You want to clear all the data in log of workbook-a?
2. Now once you clear all the data you want the data to copy from workbook-b..Log sheet to workbook-a log sheet?
3. Then you want to run the macro to combine all the data in log sheet only of workbook-a?
4. Now when you have combined the data you want to clear all data from log sheet in workbook-b first and then past the revised data in the workbook from this log sheet?

Is this what you are looking for??

Saurabh...
1
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Milind AgarwalAuthor Commented:
1. Log Tab would not be present in Workbook A. It will be present in Workbook B.
2. Once I run the Macro, Log Tab from Workbook B would go to Workbook A.(New Step)
3. Then all the data from different Tabs in workbook A gets populated in Log Tab(Presently code is doing this)
4. Once data is populated in Log Tab, the Tab gets deleted from Workbook A and brought back to Workbook B with data in that tab(New step)

Please let me know if that make sense.

Thanks,
Milind
0
Saurabh Singh TeotiaCommented:
Milind,

Final two questions:-

1. Will you be running this macro from Workbook-A or Workbook-B?
2. Let's say if you are running this from workbook-A then will be the workbook-B is open or you want to open it first? Or let's say if you are running from workbook-B then workbook-a will be open or you want to open first??

Saurabh...
1
Milind AgarwalAuthor Commented:
Saurabh,
The content of workbook - A will always change. Its kind of dynamic. If I run the macro from Workbook A, I'll have to copy the macro in to a new version of Workbook -A I receive each time.  Thats what I was doing.

Workbook B wouldn't change. So I can save this workbook as a macro based workbook and don't have to worry about copy pasting the macro each time.

If I can keep the two workbook in the same folder I perhaps don't have to worry about setting path in the macro right? If I run the macro from Workbook B the workbook A has to be open? I can keep it open if that helps.

Thanks,
Milind
0
Saurabh Singh TeotiaCommented:
Milind,

I believe this is what you are looking for it assumes both workbook-a and workbook-b on the same path and does the necessary thing for you...

Sub movedata()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim ws As Worksheet
    Dim xpath As String

    Set wb = ThisWorkbook
    xpath = ThisWorkbook.Path
    Set ws = Sheets("Log")

    Set wb1 = Workbooks.Open(xpath & "\Workbook-A.xlsx")

    ws.Move After:=wb1.Sheets(wb1.Sheets.Count)

    Dim ws1 As Worksheet
    Dim lrow As Long, cell As Range, rng As Range
    Dim lr As Long
    Set ws1 = Sheets("Log")

    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lr > 2 Then ws1.Range("A3:E" & lr).Clear    '<=If you dont want to clear old data from sheet log then remove this line

    For Each ws In wb1.Worksheets
        If ws.Name <> ws1.Name Then
            lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lrow > 5 Then
                Set rng = ws.Range("J6:J" & lrow)

                For Each cell In rng

                    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

                    'If UCase(Trim(cell.Value)) = "YES" Then'
                    ws1.Range("A" & lr).Value = Application.WorksheetFunction.Max(ws1.Range("a:a")) + 1
                    ws1.Range("b" & lr).Value = ws.Range("G" & cell.Row).Value
                    ws1.Range("C" & lr).Value = ws.Range("D" & cell.Row).Value
                    ws1.Range("D" & lr).Value = ws.Range("F" & cell.Row).Value
                    ws1.Range("E" & lr).Value = ws.Range("E" & cell.Row).Value
                    'End If'


                Next cell

            End If
        End If

    Next ws


    ws1.Move After:=wb.Sheets(wb.Sheets.Count)

    wb1.Close (False)
    wb.Save

End Sub

Open in new window


Saurabh...
0
Milind AgarwalAuthor Commented:
Saurabh,
I am getting 'RUN TIME ERROR '440' AUTOMATION ERROR' when I ran the code.  I have highlighted the line where it is erroring out.  I saw the Log tab getting created in the workbook A but once it enters the below loop it is erroring out.

                    ws1.Range("A" & lr).Value = Application.WorksheetFunction.Max(ws1.Range("a:a")) + 1
                   ws1.Range("b" & lr).Value = ws.Range("G" & cell.Row).Value
                    ws1.Range("C" & lr).Value = ws.Range("D" & cell.Row).Value
                    ws1.Range("D" & lr).Value = ws.Range("F" & cell.Row).Value
                    ws1.Range("E" & lr).Value = ws.Range("E" & cell.Row).Value
                    'End If'

Thanks,
Milind
0
Saurabh Singh TeotiaCommented:
Milind,

Use this..

Sub movedata()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim wk As Worksheet
    Dim xpath As String

    Set wb = ThisWorkbook
    xpath = ThisWorkbook.Path
    Set wk = Sheets("Log")

    Set wb1 = Workbooks.Open(xpath & "\Workbook-A.xlsx")

    wk.Move After:=wb1.Sheets(wb1.Sheets.Count)

    Dim ws1 As Worksheet
    Dim lrow As Long, cell As Range, rng As Range
    Dim lr As Long
    Set ws1 = Sheets("Log")

    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lr > 2 Then ws1.Range("A3:E" & lr).Clear    '<=If you dont want to clear old data from sheet log then remove this line

    For Each ws In wb1.Worksheets
        If ws.Name <> ws1.Name Then
            lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lrow > 5 Then
                Set rng = ws.Range("J6:J" & lrow)

                For Each cell In rng

                    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

                    'If UCase(Trim(cell.Value)) = "YES" Then'
                    ws1.Range("A" & lr).Value = Application.WorksheetFunction.Max(ws1.Range("a:a")) + 1
                    ws1.Range("b" & lr).Value = ws.Range("G" & cell.Row).Value
                    ws1.Range("C" & lr).Value = ws.Range("D" & cell.Row).Value
                    ws1.Range("D" & lr).Value = ws.Range("F" & cell.Row).Value
                    ws1.Range("E" & lr).Value = ws.Range("E" & cell.Row).Value
                    'End If'


                Next cell

            End If
        End If

    Next ws


    ws1.Move After:=wb.Sheets(wb.Sheets.Count)

    wb1.Close (False)
    wb.Save

End Sub

Open in new window

0
Milind AgarwalAuthor Commented:
Hey Saurabh,
Getting the same error same place.

Thanks.
0
Saurabh Singh TeotiaCommented:
Unfortunately...I'm not able to replicate the error at my end..Enclosed is the copy of workbook-a and b which i ran..

Can you check and let me know whats the difference between this and your workbooks??

Saurabh...
Workbook-A.xlsm
Workbook-B.xlsm
0
Milind AgarwalAuthor Commented:
Saurabh,
Attached are my workbooks I am seeing the same issue. Run time 440 error.  I see you have saved the workbook as Macro enabled xlsm. I tried doing that it didnt help. I think its the issue with my Workbook -A but I couldnt able to find the issue. Does this have to do with excel version?

Thanks,
Milind
Workbook-A.xlsx
Workbook-B.xlsx
0
Saurabh Singh TeotiaCommented:
In your workbook-A sheet-3 was completely empty that's why you were getting the error..Their you go use this one..fixed that part...

Sub movedata()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim wk As Worksheet
    Dim xpath As String

    Set wb = ThisWorkbook
    xpath = ThisWorkbook.Path
    Set wk = Sheets("Log")

    Set wb1 = Workbooks.Open(xpath & "\Workbook-A.xlsx")

    wk.Move After:=wb1.Sheets(wb1.Sheets.Count)

    Dim ws1 As Worksheet
    Dim lrow As Long, cell As Range, rng As Range
    Dim lr As Long
    Set ws1 = Sheets("Log")

    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lr > 2 Then ws1.Range("A3:E" & lr).Clear    '<=If you dont want to clear old data from sheet log then remove this line

    For Each ws In wb1.Worksheets
        If ws.Name <> ws1.Name Then
          If ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row > 5 Then lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            If lrow > 5 Then
                Set rng = ws.Range("J6:J" & lrow)

                For Each cell In rng

                    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

                    'If UCase(Trim(cell.Value)) = "YES" Then'
                    ws1.Range("A" & lr).Value = Application.WorksheetFunction.Max(ws1.Range("a:a")) + 1
                    ws1.Range("b" & lr).Value = ws.Range("G" & cell.Row).Value
                    ws1.Range("C" & lr).Value = ws.Range("D" & cell.Row).Value
                    ws1.Range("D" & lr).Value = ws.Range("F" & cell.Row).Value
                    ws1.Range("E" & lr).Value = ws.Range("E" & cell.Row).Value
                    'End If'


                Next cell

            End If
        End If

    Next ws


    ws1.Move After:=wb.Sheets(wb.Sheets.Count)

    wb1.Close (False)
    wb.Save

End Sub

Open in new window

0
Milind AgarwalAuthor Commented:
Saurabh,
I am getting the same error message but this time its a different line.

For Each ws In wb1.Worksheets
        If ws.Name <> ws1.Name Then
          If ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row > 5 Then lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
           If lrow > 5 Then
                Set rng = ws.Range("J6:J" & lrow)
0
Saurabh Singh TeotiaCommented:
Not sure why you getting the error as the code runs fine for me..anyways change the line-29 which is this...

If ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row > 5 Then lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Open in new window


to this..

lrow=ws.cells(cells.rows.count,"A").END(xlup).row

Open in new window


Saurabh...
0
Milind AgarwalAuthor Commented:
Did as u said still the issue exist.

Sub movedata()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wb As Workbook
    Dim wb1 As Workbook
    Dim wk As Worksheet
    Dim xpath As String

    Set wb = ThisWorkbook
    xpath = ThisWorkbook.Path
    Set wk = Sheets("Log")

    Set wb1 = Workbooks.Open(xpath & "\Workbook-A.xlsx")

    wk.Move After:=wb1.Sheets(wb1.Sheets.Count)

    Dim ws1 As Worksheet
    Dim lrow As Long, cell As Range, rng As Range
    Dim lr As Long
    Set ws1 = Sheets("Log")

    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lr > 2 Then ws1.Range("A3:E" & lr).Clear    '<=If you dont want to clear old data from sheet log then remove this line

    For Each ws In wb1.Worksheets
        If ws.Name <> ws1.Name Then
          lrow = ws.Cells(Cells.Rows.Count, "A").End(xlUp).Row
            If lrow > 5 Then
                Set rng = ws.Range("J6:J" & lrow)

                For Each cell In rng

                    lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

                    'If UCase(Trim(cell.Value)) = "YES" Then'
                    ws1.Range("A" & lr).Value = Application.WorksheetFunction.Max(ws1.Range("a:a")) + 1
                    ws1.Range("b" & lr).Value = ws.Range("G" & cell.Row).Value
                    ws1.Range("C" & lr).Value = ws.Range("D" & cell.Row).Value
                    ws1.Range("D" & lr).Value = ws.Range("F" & cell.Row).Value
                    ws1.Range("E" & lr).Value = ws.Range("E" & cell.Row).Value
                    'End If'


                Next cell

            End If
        End If

    Next ws


    ws1.Move After:=wb.Sheets(wb.Sheets.Count)

    wb1.Close (False)
    wb.Save

End Sub

Open in new window


Milind
0
Saurabh Singh TeotiaCommented:
Milind,

I can't replicate the issue at my end so i got no idea what's happening..if you see the workbook which you gave me and run the code in them it works perfectly fine so i need to see in your workbook why it's failing..

Saurabh...
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Milind AgarwalAuthor Commented:
Actually If i take the workbook B that you attached it working with my Workbook A.

Many Thanks Saurabh
0
Saurabh Singh TeotiaCommented:
You are welcome Milind.. Always Happy to help.. :-)

Saurabh...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.