0

I wanna copy all the rows of first 4 column from multiple excel sheet of the same workbook to a single sheet of another workbook (With header copied only once). Below is the code that I have written to do so, but it is copying the whole range. I am not able to copy the first 4 columns exclusively. Please Help.

on error resume next
set objexcel = createobject ("Excel.Application")

Dim objexcel
dim objworkbook1, objworkbook2, objworksheet
dim i,startrow,intnewrow,endrow,countsheet
dim Firstcell,lastcell
strpath = "C:\Documents and Settings\SupriyaS\Desktop\Copy of Movement Report"

Set objWorkbook2= objExcel.Workbooks.Add()
objWorkbook2.SaveAs("C:\Documents and Settings\SupriyaS\Desktop\Master Dump")

set objworkbook1 = objexcel.workbooks.open(strpath)

countSheet = objworkbook1.Sheets.Count

intnewrow=1
i = 1

for i = 1 to countsheet
wscript.echo i

Set objWorksheet = objWorkbook1.WorkSheets(i)
objworksheet.Activate

'copy from the 2nd row 
If intNewRow = 1 Then
startrow = 1
Else
startrow = 2
End If

'count the number of used row
endrow = objWorkbook1.Worksheets(i).UsedRange.Rows.Count

'copy the data
objWorkbook1.Worksheets(i).Range(startrow &":"& endrow).select
objexcel.selection.copy

'paste it on workbook2
objWorkbook2.Worksheets("Sheet1").Cells(intNewRow,1).Pastespecial

'increment the row
intNewRow = intNewRow + (endrow - startrow + 1)

next

objworkbook1.close
objworkbook2.save
objworkbook2.close

msgbox "Done"
Learner
  • 51
  • 1
  • 9
  • change `.Range(startrow &":"& endrow).select` to `.Range("A" & startrow &":D"& endrow).select` and also read 1) [How to avoid using Select/Active statements](http://stackoverflow.com/questions/10714251/excel-macro-avoiding-using-select) 2) [How to determine last used row/column](http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba/11169920#11169920) – Dmitry Pavliv Apr 15 '14 at 12:58
  • Sure i will go through the links. – Learner Apr 15 '14 at 13:03

1 Answers1

1

As I mentioned in comments, change 

objWorkbook1.Worksheets(i).Range(startrow &":"& endrow).select
objexcel.selection.copy

to 

objWorkbook1.Worksheets(i).Range("A" & startrow &":D"& endrow).Copy

And also it would be helpful for you to read

Community
  • 1
  • 1
Dmitry Pavliv
  • 35,333
  • 13
  • 79
  • 80