Copy/Paste Macro for columns-Need to match by Header

[coydog78]

Hi,

I have this code that will copy/paste multiple columns between two spreadsheets, basically an "import". The issue is that the "Import" sheet will always be changing with more or less columns than the "Main" worksheet (which is the template).

The code below just copy/pastes all columns. I need a way to match the headers text and paste all the related data from "Import" sheet to "Main".

Here is my code, any help would be appreciated:

Sub CopyByHeader()

Dim shtImport As Worksheet
Dim shtMain As Worksheet
Set shtImport = ActiveSheet ' "import" - could be different workbook
Set shtMain = ThisWorkbook.Sheets("Main")
Dim lCopyColumn As Long
Dim lCopyRow As Long
Dim lLastRowOfColumn As Long '- for each column in row 1 of import sheet
For lCopyColumn = 1 To shtImport.Cells(1, shtImport.Columns.Count).End(xlToLeft).Column
'- check what the last row is with data in column
lLastRowOfColumn = shtImport.Cells(shtImport.Rows.Count, lCopyColumn).End(xlUp).Row
'if last row was larger than one then we will loop through rows and copy
If lLastRowOfColumn > 1 Then
For lCopyRow = 1 To lLastRowOfColumn
'- copying to the corresponding cell address, this can be modified.
shtMain.Cells(lCopyRow + 6, lCopyColumn).Value = shtImport.Cells(lCopyRow, lCopyColumn).Value
Next lCopyRow
End If
Next lCopyColumn
End Sub


Thanks!

 

[patel45]

I need a way to match the headers text and paste all the related data from "Import" sheet to "Main".

it's not clear for me, can you attach a sample of current and desired table ? your code works fine.

 

[coydog78]

Hi,

I have this code that will copy/paste multiple columns between two spreadsheets, basically an "import". The issue is that the "Import" sheet will always be changing with more or less columns than the "Main" worksheet (which is the template).

The code below just copy/pastes all columns. I need a way to match the headers text and paste all the related data from "Import" sheet to "Main".

Here is my code, any help would be appreciated:

Sub CopyByHeader()

Dim shtImport As Worksheet
Dim shtMain As Worksheet
Set shtImport = ActiveSheet ' "import" - could be different workbook
Set shtMain = ThisWorkbook.Sheets("Main")
Dim lCopyColumn As Long
Dim lCopyRow As Long
Dim lLastRowOfColumn As Long '- for each column in row 1 of import sheet
For lCopyColumn = 1 To shtImport.Cells(1, shtImport.Columns.Count).End(xlToLeft).Column
'- check what the last row is with data in column
lLastRowOfColumn = shtImport.Cells(shtImport.Rows.Count, lCopyColumn).End(xlUp).Row
'if last row was larger than one then we will loop through rows and copy
If lLastRowOfColumn > 1 Then
For lCopyRow = 1 To lLastRowOfColumn
'- copying to the corresponding cell address, this can be modified.
shtMain.Cells(lCopyRow + 6, lCopyColumn).Value = shtImport.Cells(lCopyRow, lCopyColumn).Value
Next lCopyRow
End If
Next lCopyColumn
End Sub


Thanks!

The "Import Sheet" will have different column headers depending on what is pasted onto that worksheet. What I am trying to do is have the macro match the headers between "Import" sheet and "Main" and paste the data within each column. Right now, the code above works, but if a column is added to "Import" sheet, the macro just pastes onto "Main" and isn't locating the correct header to paste under.

Example:

"Import Sheet" has the following column headers with data below:

[TABLE="width: 500"]
<TBODY>[TR]
[TD]Time Started
[/TD]
[TD]Client
[/TD]
[TD]Decription Of Task
[/TD]
[TD]Inquiry Type
[/TD]
[/TR]
[TR]
[TD]9:45
[/TD]
[TD]Ford
[/TD]
[TD]Blah blah blah
[/TD]
[TD]Accounting
[/TD]
[/TR]
[TR]
[TD]9:46
[/TD]
[TD]Toyota
[/TD]
[TD]Blah Blah blah
[/TD]
[TD]Accounting
[/TD]
[/TR]
[TR]
[TD]9:47
[/TD]
[TD]GM
[/TD]
[TD]Blah blah blah
[/TD]
[TD]Accounting
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]

My "Main" sheet is my template, and will always have the same column headers.



What I need to do is import from "Import" into "Main" and match the headers/data accordingly. If "Time Started" is in a different location, then the macro is just finding that header and pasting the data underneath it.

The current code just copies the "Import" sheet and pastes it into "Main", regardless of the header.

Right now the <CODE>lLastRowOfColumn </CODE>loops through the input columns and just pastes them directly to the output at the same location.

I need to dynamically find where to paste using a "for" loop through the destination sheet's header row to find which header matches the column you're about to paste the rows to

 

[patel45]

attach please a link to a sample file

 

[coydog78]

I'm not sure how to do that

 

[Ingolf]

Hello,
@ Patel
I think coydog78 want to say : Supposedly sheet "Import" header is AA, CC, MM and sheet "Main" headers is AA, BB, CC, DD, FF, MM and coydog78 want to copy the columns with header AA, CC, MM in the same header in sheet "Main" , no matter the order of columns.

 

[coydog78]

Correct InGolf, I came up with this:

Sub ImportTimeStudy()
Dim myHeaders, e, x, wsImport As Worksheet, wsMain As Worksheet
Dim r As Range, c As Range
myHeaders = Array(Array("Time Started", "Time Started"), Array("Description of the task", "Description of the task"), Array("Level", "Level"), Array("Location", "Location"), Array("Targeted", "Targeted"), Array("System", "System"), Array("Process Code", "Process Code"), _
Array("Value Stream", "Value Stream"), Array("Subject", "Subject"), Array("BU", "BU"), Array("Task Duration", "Task Duration"), Array("Activity Code", "Activity Code"))

Set wsImport = Sheets("Import")
Set wsMain = Sheets("Main")
For Each e In myHeaders
Set r = wsImport.Cells.Find(e(0), , , xlWhole)

If Not r Is Nothing Then
Set c = wsMain.Cells.Find(e(1), , , xlWhole)

If Not c Is Nothing Then
wsImport.Range(r.Offset(1), wsImport.Cells(Rows.Count, r.Column).End(xlUp)).Copy _
wsMain.Cells(Rows.Count, c.Column).End(xlUp)(2)
Else
msg = msg & vbLf & e(1) & " " & wsMain.Name
End If
Else
msg = msg & vbLf & e(0) & " " & wsImport.Name
End If

Next
If Len(msg) Then
MsgBox "Header not found" & msg

End If
Application.ScreenUpdating = False
End Sub

 

[coydog78]

(This is pretty slow, but not too bad. If I could speed it up, it would be perfect)

 

[marianliu]

(This is pretty slow, but not too bad. If I could speed it up, it would be perfect)

I have the same issue as Coydog78, I have a template with multiple columns, and another sheet send from my vendor, their columns header sometimes will be less or more. what I need to copy the data underneath header to match my templato. I want to use" transfer" the file (from vendor) to my template. just copy the matched header.

For example: uner the AA, BB, CC, DD... there are many rows data underneath those columns. I want to copy sheet1 coloumn header's data to match Template header text then copy all rows data to template

any suggestion on code writing will be appreciated.

sheet1
AA BB CC DD FF


Template:

AA CC FF

 

[Silver Ripple]

Dear friends, I am really bad at dealing with loops and I am stuck.
This code is exactly what I need but I'd really appreciate if anyone could tell me how this code could be changed to loop through the sheets instead of just checking only the "import sheet". Thanks in advance.

If code change cannot be provided, any pointers on how to change this code would be appreciated so I could try something. Thanks again.