CODEWITHSUNDEEP
vbaexcel
Aaron C
Aaron C

Reputation: 135

vba - Copy all data in column except column title

I am searching for a column in people workbook and copying it to the next blank row in rota workbook. The problem i have is that it is copying the column header as well (first row). Based on the below code, any suggestions on how to exclude the first row containing the column headers?

' find the column in the people workbook
name = WorksheetFunction.Match("name", people.Sheets("Open").Rows(1), 0)
num = WorksheetFunction.Match("num", people.Sheets("Open").Rows(1), 0)

'find the next empty row
Dim lastrow As Integer
lastrow = rota.Sheets("Offer").Range("A" & Rows.Count).End(xlUp).Row + 1

' copy from the people workbook into the next free space in rota workbook
people.Sheets("Open").Columns(name).Copy Destination:=rota.Sheets("Offer").Range("A" & Rows.Count).End(xlUp).Offset(1)
people.Sheets("Open").Columns(num).Copy Destination:=rota.Sheets("Offer").Range("B" & lastrow)

Im guessing its at the below point that i need to specify not to copy the first row instead of copying the full column named "num"...

people.Sheets("Open").Columns(num).Copy Destination:=rota.Sheets("Offer").Range("B" & lastrow)

Upvotes: 1

Views: 6275

Answers (2)

Dirk Reichel
Dirk Reichel

Reputation: 7979

To leave it as much as it is, I suggest just using Intersect, UsedRange and Offset. Just change your last part to:

' copy from the people workbook into the next free space in rota workbook
With people.Sheets("Open")
  Intersect(.Columns(Name), .UsedRange.Offset(1)).Copy Destination:=rota.Sheets("Offer").Range("A" & Rows.Count).End(xlUp).Offset(1)
  Intersect(.Columns(num), .UsedRange.Offset(1)).Copy Destination:=rota.Sheets("Offer").Range("B" & lastrow)
End With

Upvotes: 3

Pierre Chevallier
Pierre Chevallier

Reputation: 754

It is indeed the

.Columns(num).Copy

that is taking the header, due to the fact that it copies the entire column (hence the ".Columns().Copy") .

I would suggest using a different approach with array in order to copy & paste the data in the worksheet rota :

Dim arrayCopied(), lastline as long

' find the column in the people workbook
Name = WorksheetFunction.Match("name", people.Sheets("Open").Rows(1), 0)
num = WorksheetFunction.Match("num", people.Sheets("Open").Rows(1), 0)

'Loading the data from sheet Open in the array
' We load the array from the second line : .cells(2,name)
With people.Sheets("Open")
    arrayCopied = Range(.Cells(2, Name), .Cells(2, num).End(xlDown))
End With

' Then we paste the data in the corresponding place in the rota sheet
With rota.Sheets("Offer")
    'First we calculate where the last row is:
    lastline = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown)).Rows.Count
    'Then we paste the array starting at the last line and finishing at the last line
    '+ the number of lines of the corresponding copied array - 1 (because Excel cells start at 1 and not at 0)
    .Range(.Cells(lastline, 1), .Cells(lastline + UBound(arrayCopied, 1) - 1, 2)) = arrayCopied
End With

This should do the trick.

Upvotes: 0

Related Questions