copy specific content from one excel workbook to another workbook

Question

I am new to VB and developing a VB script that will take a input excel file and convert to another excel file (new Excel File) with some changes to it.

I have created a macro file which is taking and input file and and creating the new excel file exactly same as the original one but with a new name and at a given location.

Convert J3 to Phase 1 button is converting the selected excel workbook to new workbook with same content.

Here is my code till now. Sorry If coding standards are not followed as I am very new to VB.

Sub convertJ3ToPhase1()
j3ExcelSheet = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Open Database File")
Dim SourceFile, DestinationFile
SourceFile = j3ExcelSheet
DestinationFile = "C:\Test\ABC.xlsx" ' Define target file name.
FileCopy SourceFile, DestinationFile ' Copy source to target.
End Sub

ABC.xlsx contains the same data as the original excel workbook.

However my requirement is something different.

Here is my original Excel file

Now what I want is from the first cell to 9th cell(i.e from Site to All partial transfer) the content should be copied to 1st sheet (named Header Sheet) of newly created Workbook while for other data after 10th row(i.e the table data) I only want specific columns in my new workbook (i.e I want 10/19 columns present) that too in the separate sheet (Details Sheet) of the workbook.

Here is the snapshots of how I want data in my new Workbook.

In the above image I want top 9 rows data in Header Tab

In Second Sheet (Details Sheet) I want only particular columns from the original workbook.

Can Anyone Please Help me in writing the VB script as I don't have much knowledge of Syntax and Method of VB Scripting?

Answer 1

How about something like this, you will have to change a number of variables in the code to match the names of your sheets, etc.:

Sub BrowseForJ3File()
Dim x As Workbook
    j3ExcelSheet = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Open Excel File")
    If fileToOpen <> False Then
        MsgBox "Open " & fileToOpen
    End If

    ActiveSheet.Range("H9") = j3ExcelSheet

    Pos = InStrRev(j3ExcelSheet, "\")
    Filename = Mid(j3ExcelSheet, Pos + 1)
    'above get the filename

    Pos = InStrRev(Filename, ".")
    Extension = Mid(Filename, Pos + 1)
    'above get the extension

    Savepath = "C:\Users\Me\Desktop\"
    'get the path to save the new file

    NewFilename = "New Report"
    'above new filename

    Application.DisplayAlerts = False
    SheetName = "Sheet1" 'change this to the original Sheet Name

    Set x = Workbooks.Open(j3ExcelSheet)
    With x
        x.Sheets(SheetName).Range("A1:B9").Copy 'copy range to paste headers
        x.Sheets.Add().Name = "Header" 'add sheet Header
        x.Sheets("Header").Paste 'paste the copied range
        x.Sheets.Add().Name = "Detail" 'add details sheet
        LastRow = x.Sheets(SheetName).Cells(x.Sheets(SheetName).Rows.Count, "A").End(xlUp).Row 'get the last row with data from original sheet
        x.Sheets(SheetName).Range("A11:Q" & LastRow).Copy 'copy range
        x.Sheets("Detail").Paste 'paste into Detail
        x.Sheets("Detail").Range("D:D,F:N").Select 'select columns to delete
        Selection.Delete Shift:=xlToLeft
        x.Sheets(SheetName).Delete 'delete original Sheet

        .SaveAs Savepath & NewFilename & "." & Extension 'save with new name
        .Close
    End With
    Application.DisplayAlerts = True
 End Sub