0

I am fairly new to Excel VBA and have been trying to look for (as well as come up with my own) solutions to a dilemma I am facing. Routinely, I receive raw data files from a colleague and these raw data files may have varying number of columns but consistent header names. I have in my workbook, a master spreadsheet that I want to keep up to date by appending the new data (so keep appending data of new spreadsheet to next empty row). I would like to create a macro that can take the imported spreadsheet (say, spreadsheet A) and look at the header value of a column, copy the column range (starting from row 2 to end of populated within column), go to spreadsheet Master, look for header value, and paste the column range in the next empty cell down in the column. And this procedure would be for all columns present in spreadsheet A.

Any help/guidance/advice would be very much appreciated.

Ex) I have "master" sheet and "imported" sheet. I want to take the "imported" sheet, look at headers in row 1, starting from column 1. If that header is present in "master" sheet, copy the column (minus the header) from "imported sheet" and paste into "master" under the appropriate column header starting from the next empty cell in that column. What I ultimately want to do is keep the "master" sheet with historical data but the "imported" sheet contains columns which moves around so I just couldn't copy and paste the range starting from next empty cell in master.

Improve this question
2
  • What isn't working in this code? What specifically do you need changed? Commented Mar 21, 2012 at 13:31
  • Do all columns have the same number of rows? Following your instructions to paste in the first empty cell by column, couldn't that lead to your rows being mis-aligned? Commented Mar 21, 2012 at 14:59

2 Answers 2

Reset to default
3

Untested but compiles OK:

Sub CopyByHeader() Dim shtA As Worksheet, shtB As Worksheet Dim c As Range, f As Range Dim rngCopy As Range, rngCopyTo Set shtA = ActiveSheet ' "incoming data" - could be different workbook Set shtB = ThisWorkbook.Sheets("Master") For Each c In Application.Intersect(shtA.UsedRange, shtA.Rows(1)) 'only copy if >1 value in this column (ie. not just the header) If Len(c.Value) > 0 And Application.CountA(c.EntireColumn) > 1 Then Set f = shtB.Rows(1).Find(what:=c.Value, LookIn:=xlValues, _ LookAt:=xlWhole) If Not f Is Nothing Then Set rngCopy = shtA.Range(c.Offset(1, 0), _ shtA.Cells(Rows.Count, c.Column).End(xlUp)) Set rngCopyTo = shtB.Cells(Rows.Count, _ f.Column).End(xlUp).Offset(1, 0) 'copy values rngCopyTo.Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value End If End If Next c End Sub

EDIT: updated to only copy columns which have any content, and to only copy values

Improve this answer
Sign up to request clarification or add additional context in comments.

2 Comments

Hi Tim, the code seems to perform a copy and paste but it does not seem to be consistent. In one case it also copied the header as well. Can you provide a bit more direction on resolving this issue? These instances only happen when the column contains no values in the original imported sheet. So if column B had no value on imported sheet, it would copy just the header into the master sheet. And I had another question. How can I modify the code to paste values only? The only way I could think of was using .PasteSpecial xlPasteValues but no success. Thank you, and your help is much appreciated.
Tim, thank you for all of your help and advice. It is greatly appreciated.
1

I cannot get the above to work, and need the same result as the original question. Any thoughts on what is missing? I thought I changed everything that needed to be changed to fit my sheets: 

Sub CopyByHeader() Dim shtMain As Worksheet, shtImport As Worksheet Dim c As Range, f As Range Dim rngCopy As Range, rngCopyTo Set shtImport = ActiveSheet ' "Import" Set shtMain = ThisWorkbook.Sheets("Main") For Each c In Application.Intersect(shtImport.UsedRange, shtImport.Rows(1)) 'only copy if >1 value in this column (ie. not just the header) If Len(c.Value) > 0 And Application.CountA(c.EntireColumn) > 1 Then Set f = shtMain.Rows(1).Find(what:=c.Value, LookIn:=xlValues, _ LookAt:=xlWhole) If Not f Is Nothing Then Set rngCopy = shtImport.Range(c.Offset(1, 0), _ shtImport.Cells(Rows.Count, c.Column).End(xlUp)) Set rngCopyTo = shtMain.Cells(Rows.Count, _ f.Column).End(xlUp).Offset(1, 0) 'copy values rngCopyTo.Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value End If End If Next c End Sub

Thanks, Ryan

Improve this answer

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.