Copy rows from one workbook to another

[akulka58]

Hi All,

I do have 2 workbooks.

1) Template.xlsx
2) Worth.xlsx

I need to open Worth.xlsx and activate sheet named as “ISSUES”.

After activating “ISSUES” sheet I need to copy all rows from “Issues” and paste in Template.xlsx (Sheet name is “Worth ISSUES”). Data should pasted from row number 2 because 1 row has header.

After pasting data “ISSUES” sheet must deleted from worth.xlsx and save

I need to open both workbooks via application.getfileopen command. So that user can select both workbooks. (Folder path always change that’ why)

Error Handling: - If “ISSUES” sheet does not exist then code should how msgbox and exit macro.

Please help.

[ihmha]

I adapted this from something I already have.
It might be a bit long winded but it should work.

Sub Import_Worth_Issues()
Dim varFileFilter As Variant ''file command
Dim intFilterIndex As Integer ''file command
Dim strTitle As String ''file command
Dim c ''variant for file name command

Dim strThisWB As String
Dim strIssuesWB As String

    On Error Resume Next
    
    ''turn off the screen warnings
    Application.DisplayAlerts = False
    
    ''set the directory to the current path
    ChDir (ActiveWorkbook.Path)
    
    ''get this workbook name for the returning call
    strThisWB = ActiveWorkbook.Name

    ''set up the file open command
    varFileFilter = "XL* (*.XL*), *.XL*"
    intFilterIndex = 1
    strTitle = "Please Select The Worth XLS File"
    c = Application.GetOpenFilename(varFileFilter, intFilterIndex, strTitle)
    
    ''check if the user has selected a workbook
    If c <> "False" Then

        On Error Resume Next
        
        intFilterIndex = InStrRev(c, "\")
        
        ''used to check if the workbook is open
        strIssuesWB = Mid(c, intFilterIndex + 1)
        ''open the workbook
        If Workbooks(strIssuesWB) Is Nothing Then
            Workbooks.Open (c)
        Else
            Workbooks(strIssuesWB).Activate
        End If
        
        ''check for the issues worksheet
        For Each c In ActiveWorkbook.Worksheets
            If UCase(c.Name) = "ISSUES" Then GoTo LOADDATA
        Next
        
        ''exit if not found
        MsgBox "There is no 'ISSUES' worksheet in the selected Worth workbook"
        
        ''ActiveWorkbook.Close False ''remove the comments from this line if you want to close the workbook
        
        Exit Sub
        
    Else
        
        ''exit if no workbook is selected
        MsgBox "There is no Worth file selected"
        Exit Sub
    End If
    
LOADDATA:

    ''clear down the old data
    Workbooks(strThisWB).Activate
    Worksheets("Worth ISSUES").Activate
    
    strTitle = ActiveSheet.UsedRange.Address
    strTitle = Mid(strTitle, InStr(strTitle, ":") + 1)
    
    'check if we have valid data to avoid deletign the header
    If Mid(strTitle, InStrRev(strTitle, "$") + 1) = 1 Then strTitle = "A2"
    ''set the range to clear down
    strTitle = "A2:" & strTitle
    ActiveSheet.Range(strTitle).Select
    Selection.ClearContents
    
    ''copy the data
    Workbooks(strIssuesWB).Activate
    Worksheets("ISSUES").Activate
    ActiveSheet.UsedRange.Select
    Selection.Copy
    
    ''paste it in the template workbook
    Workbooks(strThisWB).Activate
    ActiveSheet.Paste Destination:=Worksheets("Worth ISSUES").Cells(2, 1)
    Application.CutCopyMode = False
    Cells(1, 1).Select
    
    ''remove the issues worksheet
    Workbooks(strIssuesWB).Activate
    Worksheets("ISSUES").Delete
    
    ''close and save the workbook
    ActiveWorkbook.Close True
    ''turn on the alerts
    Application.DisplayAlerts = True
    
End Sub

[akulka58]

Hi Ihmha,

Thanks a lot for your reply. But its copying data in master workbook. I need to open Template.xlsx. Code should not copy data in macro book.

[ihmha]

Added some revise code and error handling.
You would need to have the template.xlsx workbook in the same directory for it to run, or make this a personal macro which allows you to run it on any workbook.

Sub Import_Worth_Issues()
Dim varFileFilter As Variant ''file command
Dim intFilterIndex As Integer ''file command
Dim strTitle As String ''file command
Dim c ''variant for file name command

Dim strThisWB As String
Dim strIssuesWB As String

    On Error Resume Next
    
    ''turn off the screen warnings
    Application.DisplayAlerts = False
    
    ''set the directory to the current path
    ChDir (ActiveWorkbook.Path)
    
    ''get this workbook name for the returning call
    strThisWB = "Template.xlsx"
    
    Workbooks(strThisWB).Activate
        
    ''check for the issues worksheet
    For Each c In ActiveWorkbook.Worksheets
        If c.Name = "Worth ISSUES" Then GoTo FOUNDIT
    Next
    
    ''exit if not found
    MsgBox "There is no 'Worth ISSUES' worksheet in the Template workbook"
    Exit Sub
    
    
FOUNDIT:

    ''set up the file open command
    varFileFilter = "XL* (*.XL*), *.XL*"
    intFilterIndex = 1
    strTitle = "Please Select The Worth XLS File"
    c = Application.GetOpenFilename(varFileFilter, intFilterIndex, strTitle)
    
    ''check if the user has selected a workbook
    If c <> "False" Then

        On Error Resume Next
        
        intFilterIndex = InStrRev(c, "\")
        
        ''used to check if the workbook is open
        strIssuesWB = Mid(c, intFilterIndex + 1)
        ''open the workbook
        If Workbooks(strIssuesWB) Is Nothing Then
            Workbooks.Open (c)
        Else
            Workbooks(strIssuesWB).Activate
        End If
        
        ''check for the issues worksheet
        For Each c In ActiveWorkbook.Worksheets
            If UCase(c.Name) = "ISSUES" Then GoTo LOADDATA
        Next
        
        ''exit if not found
        MsgBox "There is no 'ISSUES' worksheet in the selected Worth workbook"
        
        ''ActiveWorkbook.Close False ''remove the comments from this line if you want to close the workbook
        
        Exit Sub
        
    Else
        
        ''exit if no workbook is selected
        MsgBox "There is no Worth file selected"
        Exit Sub
    End If
    
LOADDATA:

    ''clear down the old data
    Workbooks(strThisWB).Activate
    Worksheets("Worth ISSUES").Activate
    
    strTitle = ActiveSheet.UsedRange.Address
    strTitle = Mid(strTitle, InStr(strTitle, ":") + 1)
    
    'check if we have valid data to avoid deletign the header
    If Mid(strTitle, InStrRev(strTitle, "$") + 1) = 1 Then strTitle = "A2"
    ''set the range to clear down
    strTitle = "A2:" & strTitle
    ActiveSheet.Range(strTitle).Select
    Selection.ClearContents
    
    ''copy the data
    Workbooks(strIssuesWB).Activate
    Worksheets("ISSUES").Activate
    ActiveSheet.UsedRange.Select
    Selection.Copy
    
    ''paste it in the template workbook
    Workbooks(strThisWB).Activate
    ActiveSheet.Paste Destination:=Worksheets("Worth ISSUES").Cells(2, 1)
    Application.CutCopyMode = False
    Cells(1, 1).Select
    
    ''remove the issues worksheet
    Workbooks(strIssuesWB).Activate
    Worksheets("ISSUES").Delete
    
    ''close and save the workbook
    ActiveWorkbook.Close True
    ''turn on the alerts
    Application.DisplayAlerts = True
    
End Sub