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

Saurabh Singh Teotia

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

Saurabh...

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

Saurabh Singh Teotia

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

Milind Agarwal

ASKER

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

Saurabh Singh Teotia

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

Milind Agarwal

ASKER

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

Saurabh Singh Teotia

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

Milind Agarwal

ASKER

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

Saurabh Singh Teotia

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

Milind Agarwal

ASKER

Hey Saurabh,
Getting the same error same place.

Thanks.

Saurabh Singh Teotia

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

Milind Agarwal

ASKER

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

Saurabh Singh Teotia

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

Milind Agarwal

ASKER

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)

Saurabh Singh Teotia

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

Milind Agarwal

ASKER

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

Saurabh Singh Teotia

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Milind Agarwal

ASKER

Actually If i take the workbook B that you attached it working with my Workbook A.

Many Thanks Saurabh

Saurabh Singh Teotia

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

Saurabh...