Copying user selected rows to different workbook and under matching columns

[LaTwiglet85]

Hi,

Hoping someone can help me as I've been struggling with this for days now.
Firstly, I have no real knowledge of VBA and Macros other than what I have picked up other the last week.

This is what I am trying to do.
I have a workbook (lets call it "source.xlsm") that has 5 tabs on it(sheet1, sheet2 etc). The headers on these tabs are all the same and in the same order.
I have another workbook (lets call it "target.csv") with just the 1 tab (sheet1) that has some of the important headers from "source"

"source" is used daily to add customer orders to (each row is a new order and contains all customers details as well as item details). A new workbook is created for each month. Depending on what is ordered will depend on what tab it goes onto.
"target" is used to copy only selected orders from "source" so that it can be uploaded to the carriers website to generate shipping labels.
We process each tab "source" individually.

So, I need a Macro that will make whatever tab I am on in "source" the active sheet. Copy whatever rows in that tab that I have selected, and copy them into "target" whilst making sure that it matches the data to the correct column.
- Ideally, it would clear any previous data in "target" (other than the headers) before doing the pasting.
- "target" would not be open. So I need it to open this file to be able to copy the contents over to it.

Through loads of googling etc, I have managed to get a working code that seems to achieve this, other than it will copy everything in the column if the headers in "source" and "target" match. I may have only selected, for example, rows 34-59 and so I only need it to copy those columns' data across. No matter how much I try to edit the code to find a solution so it works for just my selected rows I cannot get it to work.

example files
"source" headers - Ticket#, Name, Address, City, Item ordered, QTY, Picker, Shipper, Phone, Email
"target" headers - Name, Address, City, Phone, Email

This is code I have so far in the "source" workbook. (although this assumes both workbooks are open which I don't want).

Sub uploadToCarrier()

Dim wbSource As Workbook ' Source workbook
Dim wksSource As Worksheet ' Source sheet
Dim rSourceColHeaders As Range ' Source column headers

Dim wbTarget As Workbook ' Target workbook
Dim wksTarget As Worksheet ' Target sheet
Dim rTargetColHeaders As Range ' Target column headers (which will be searched through)

Dim rColHead As Range ' Iterates through the source column headers
Dim rMatchColHead As Range ' Gets the matching target column header
Dim iNumCellsPerColumn As Long ' Defines how many cells per column we're copying; 

Set wbSource = Workbooks("source.xlsm")
Set wksSource = ActiveSheet
Set rSourceColHeaders = wksSource.Range("A1:X1") 

Set wbTarget = Workbooks("target.csv")
Set wksTarget = wbTarget.Worksheets("Sheet1")
Set rTargetColHeaders = wksTarget.Range("A1:Q1") 


iNumCellsPerColumn = Selection.Rows.Count

'==========================================

' - loop through the source column header cells
' -- try to find the matching column
' -- if a match is found, copy column cells from the source to the target

For Each rColHead In rSourceColHeaders
Set rMatchColHead = rTargetColHeaders.Find(rColHead.Text, , xlValues, xlWhole)
If Not (rMatchColHead Is Nothing) Then
wksSource.Range(rColHead, rColHead.Offset(iNumCellsPerColumn, 0)).Copy
rMatchColHead.PasteSpecial xlPasteValues

End If

Next rColHead

End Sub

 

[John_w]

Try this macro after editing the path to target.csv.

Public Sub Copy_Selected_Rows_To_CSV()

    Dim sourceWs As Worksheet
    Dim selectedRows As Range, selectedRow As Range
    Dim targetWb As Workbook, targetWs As Worksheet
    Dim targetRow As Long, targetCol As Long
    Dim sourceCol As Variant
  
    Set sourceWs = ActiveSheet
    Set selectedRows = Selection.EntireRow
  
    Set targetWb = Workbooks.Open("C:\path\to\target.csv")
  
    Set targetWs = targetWb.Worksheets(1)
    targetWs.UsedRange.Offset(1).Cells.Clear
    targetRow = 2
  
    'Loop through selected rows in source sheet
  
    For Each selectedRow In selectedRows
      
        'Loop through columns 1 to last column in target sheet
      
        For targetCol = 1 To targetWs.Cells(1, targetWs.Columns.Count).End(xlToLeft).Column
          
            'Find target sheet column header in source sheet row 1
          
            sourceCol = Application.Match(targetWs.Cells(1, targetCol).Value, sourceWs.Rows(1), 0)
         
            'Copy source sheet cell value to target sheet cell
          
            targetWs.Cells(targetRow, targetCol).Value = sourceWs.Cells(selectedRow.Row, sourceCol).Value
      
        Next
      
        targetRow = targetRow + 1

    Next
  
    targetWs.UsedRange.Columns.AutoFit
    targetWb.Save
    'or save and close
    'targetWb.Close SaveChanges:=True
  
End Sub

 

[LaTwiglet85]

Hi John

Thank you for the reply.

I copied the code into the module (replacing mine and changing the target path location) and I get an error message

 

[LaTwiglet85]

Hi John,

Apologies, I have checked the target file again to find the mismatch and I have actually noticed that there is a column there that does not appear in the source file at all. Your code copies everything until it hits that column and then errors out.
Is there a way to modify the code so that if any columns in the target file do not match any in the source file to ignore that column (leave it blank) and continue to copy the rest?

 

[John_w]

I was about to ask you if the target file contains only the column headers Name, Address, City, Phone, Email. If it contains a header which doesn't appear in the source file then you'll get that error.

Replace the highlighted line with:

            If Not IsError(sourceCol) Then
                
                'Copy source sheet cell value to target sheet cell
                
                targetWs.Cells(targetRow, targetCol).Value = sourceWs.Cells(selectedRow.Row, sourceCol).Value
            
            End If

and then it will ignore target file headers which don't appear in the source file.

 

[LaTwiglet85]

This worked perfectly!!!
Thank you so much.