none
Copy the content of one excel sheet to another workbook RRS feed

  • Question

  • Hi,

    Good Morning everyone!!

    I have some content in my excel sheet(Sheet2). I want to have one macro that will copy everything from B & C column and paste that in a  new workbook.

    Let's take an example:

    Please find below the sample data that I have in my current worksheet:

    ID Product Name Manufacturer
    PM_0025 Silbiasxxzy xxx    
    PG_0825 Kritissty yyy
    GH_8741 Pinaccleffrt zzz
    FG_8525 Gellopamkkiu

    aaa

    I don't need the last 4 characters of Product name. I want to get rid of last 4 characters of the product name while the data of Column B & C will be copied in a new workbook. Manually I can remove last 4 characters but due to a large number of records, it will take a significant amount of time to accomplish this activity. Once I click on a button it will copy only B & C column and write the data to a new workbook. The final o/p will be as follows:

    Silbias xxx
    Kriti yyy
    Pinaccle zzz
    Gellopam aaa

    Headers are not needed in the new workbook.

    --ED

     

    Sunday, May 17, 2015 5:00 PM

Answers

  • Ed,

    yes there are several ways to do this.  That seemed simplest, but I see the problem.  Here is a different approach.

    Sub copysubset()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim cell As Range, r As Range

    Set sh1 = ActiveSheet
    Workbooks.Add Template:=xlWBATWorksheet  ' single sheet workbook
    Set sh2 = ActiveSheet
    sh1.Range("B:C").EntireColumn.Copy sh2.Range("A:B").EntireColumn
    sh2.Rows(1).Delete
    Set r = sh2.Range("A1", sh2.Cells(sh2.Rows.Count, 1).End(xlUp))
    For Each cell In r
      cell.Value = Left(cell.Value, Len(cell.Value) - 4)
    Next
    sh2.Parent.SaveAs "D:\MyFolder\Newbook.xlsx"
    ' if you want to close the new workbook, remove the single quote
    ' from the next line
    'sh2.Parent.Close SaveChanges:=False
    End Sub


    -- Regards,Tom Ogilvy Note: When you get an answer to your question, please mark it as the answer so others may know the question is answered.


    • Edited by Tom Ogilvy MVP Monday, May 18, 2015 8:00 PM
    • Marked as answer by Ed_Dao Wednesday, May 20, 2015 5:56 PM
    Monday, May 18, 2015 7:59 PM

All replies

  • ED,

    See if this works for you:

    Sub copysubset()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim cell As Range, r As Range
    Dim r1 As Range
    Set sh1 = ActiveSheet
    sh1.Copy
    Set sh2 = ActiveSheet
    sh2.Columns(1).Delete
    sh2.Rows(1).Delete
    Set r = sh2.Range("A1", sh2.Cells(sh2.Rows.Count, 1).End(xlUp))
    For Each cell In r
      cell.Value = Left(cell.Value, Len(cell.Value) - 4)
    Next
    Set r1 = sh2.Range("C1", sh2.Cells(1, sh2.Columns.Count))
    r1.EntireColumn.Delete
    End Sub

    --

    Regards,

    Tom Ogilvy


    Note: When you get an answer to your question, please mark it as the answer so others may know the question is answered.


    Sunday, May 17, 2015 5:49 PM
  • Tom,

    Thanks much. Once I run your code I have noticed entire sheet is getting copied along with command button. I only wanted to copy B & C Column and  is it possible to save the new workbook in my D Drive automatically with a name as Newbook.xlsx once I click the button?

    --ED

     

    Monday, May 18, 2015 5:56 PM
  • Ed,

    yes there are several ways to do this.  That seemed simplest, but I see the problem.  Here is a different approach.

    Sub copysubset()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim cell As Range, r As Range

    Set sh1 = ActiveSheet
    Workbooks.Add Template:=xlWBATWorksheet  ' single sheet workbook
    Set sh2 = ActiveSheet
    sh1.Range("B:C").EntireColumn.Copy sh2.Range("A:B").EntireColumn
    sh2.Rows(1).Delete
    Set r = sh2.Range("A1", sh2.Cells(sh2.Rows.Count, 1).End(xlUp))
    For Each cell In r
      cell.Value = Left(cell.Value, Len(cell.Value) - 4)
    Next
    sh2.Parent.SaveAs "D:\MyFolder\Newbook.xlsx"
    ' if you want to close the new workbook, remove the single quote
    ' from the next line
    'sh2.Parent.Close SaveChanges:=False
    End Sub


    -- Regards,Tom Ogilvy Note: When you get an answer to your question, please mark it as the answer so others may know the question is answered.


    • Edited by Tom Ogilvy MVP Monday, May 18, 2015 8:00 PM
    • Marked as answer by Ed_Dao Wednesday, May 20, 2015 5:56 PM
    Monday, May 18, 2015 7:59 PM