Link to home
Create AccountLog in
Avatar of Milind Agarwal
Milind AgarwalFlag for United States of America

asked on

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
Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

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

Saurabh...
Avatar of Milind Agarwal

ASKER

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

Hey Saurabh,
Getting the same error same place.

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

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)
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...
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
ASKER CERTIFIED SOLUTION
Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Actually If i take the workbook B that you attached it working with my Workbook A.

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

Saurabh...