How to copy defined columns with defined number of rows from one Excel file to another

Question

I am new to VB and I am going to use it for Quick Test Pro (QTP). I am having a problem to copy data from one Excel to another Excel file with specific rows and columns. Here is the scenario:

I have one Excel file with more than 20 rows. Let say 100 rows.
I need to copy the first row, then the 2nd to 20th rows, then save it to a different file.
I need to copy the first row, then the 21st to 41st rows, then save it to a different file.
Then same thing for the rest. Until there is NO value on the last row.

I need to copy the first row, because this is where the title/header is that I need.

So far, this is what I did. But it only copies the single column and NOT the columns that I want:

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook1 = objExcel.Workbooks.Open("C:\Report\CMaxx_File1.xlsx")
ObjExcel.Visible = True
Set objWorkbook2 = objExcel.Workbooks.Open("C:\Report\CMaxx_File2.xlsx")
objWorkbook1.Worksheets("Sheet1").Range("A1:A21").Copy
objWorkbook2.Worksheets("Sheet1").Range("A1:A21").PasteSpecial 
objWorkbook2.Save

We can help you, but we won't do your task for you. You said: I am having a problem - What problem exactly? Please edit your question and add what you have tried so far. Please also take the tour and read How to Ask to learn what we expect from questions. — honk
Could it be you have a list in at least one of the sheets? Are the column headers normal cells, or are they list column headers? — TheBlastOne
Hi The BlastOne, The header like ClientName, AcctNum, TypeCode and etc. Under each header there are values and I need to capture the header and the next 20 rows. Thanks — Beer2

Bagger Bagger · Accepted Answer · 2015-03-25T15:32:52

Still not the best way to do it but I tested it and it works. Make sure you change the variables to match your paths, also the column range

This will take a spreadsheet with more than 20 rows and create a new spreadsheets (as many as required) with 1 row header an d19 rows data (20 rows total)

  allRowsWorkbook = "C:\XXXXX\stack\x\Original.xlsx"
   newXLS = "C:\XXXXX\stack\x\New_sheet_20_rows"

    Set objExcel = CreateObject("Excel.Application")

    'Open the workbook that has all the rows
    Set objWorkbook = objExcel.Workbooks.Open(allRowsWorkbook)

     rowCnt = 2    
     LineCnt = 0
     intRow = 2
     bookCnt = 1

     'Spreadsheets that will be created

     xlsName = newXLS & bookCnt & ".xlsx"
     createNewBook(xlsName)


     Do Until objExcel.Cells(intRow,1).Value = ""

        for lineCnt = 0 to 20 
         Wscript.Echo "CN: " & objExcel.Cells(intRow, 1).Value
         intRow = intRow + 1
         lineCnt = LineCnt + 0
         rowCnt = rowCnt + 1
        next 
        LineCnt = 0
        wscript.echo "Out"
        bookCnt =  bookCnt + 1
        xlsName =  newXLS  & bookCnt & ".xlsx"
      wscript.echo    xlsName 
        createNewBook(xlsName)
     Loop

     Function createNewBook(xlsName)
     Set objExcel2 = CreateObject("Excel.Application")
         Set objWorkbook2 = objExcel2.Workbooks.Add()
      objWorkbook.Worksheets("Sheet1").Range("A1:F1").Copy
      objWorkbook2.Worksheets("Sheet1").Range("A1:F1").PasteSpecial

      objWorkbook.Worksheets("Sheet1").Range("A" & rowCnt & ":i" &(rowCnt +20) ).Copy
      'sleep was added to make sure copy had tinme to comlete
       wscript.sleep 1000
      objWorkbook2.Worksheets("Sheet1").Range("A2:i2").PasteSpecial


             objWorkbook2.SaveAs(xlsName)
             objWorkbook2.Close(xlsName)

     End Function

How to copy defined columns with defined number of rows from one Excel file to another

1 Answers