Copy Specific Column from One Sheet to another based on criteria from another cell

[sprague519]

I am working on a macro to generate invoices that will be saved off to a folder as PDFs. they data in the invoice is defined by the company, then a few lookups populate the header information (address contact and whatnot). The macro loops through each company and generates a document for each company. the problem i am having is populating the field data. it is all held on a "Spends" sheet where i need to copy some of but not all of the columns for a specific row of data. i need to pull column B,C,E,H,J,K,M. My filter data is in Column N and the filter criteria is in "Submission Form" "C3". I am fairly new to writing VB so the code below is comprised of a bunch of little bits i have pulled from a bunch of random places.


Thanks,
Mike

Sub Invoice()    Dim VendorList As Range
    Dim Vendor As Range
    Dim VendorSheet As Worksheet
    Dim SubmissionForm As Worksheet
    Dim Quarter As Range
    Dim FilCol1 As Range
    Dim VenQ As String
    Dim Cell As Object
    Dim SubmissionQ As Range
        
    Set VendorList = Worksheets("Vendor Sheet").Range("A2:A19")
    Set VendorSheet = Worksheets("Vendor Sheet")
    Set SubmissionForm = Worksheets("Submission Form")
    Set Quarter = Worksheets("Submission Form").Range("F7")
    Set FilCol1 = Worksheets("Spends").Range("N2:N3000") 'Filteres for the Quarter and Vendor
    Set VenQuar = Worksheets("Submission Form").Range("C3") 'Filteres for the Quarter and Vendor
    
    
' Creates a folder for the current yerar if one does not already exist
    Dim YearDir As String
        YearDir = "C:\Users\sprag\Desktop\Invoice Test\" & Format(Now, "yyyy") & "\"
        If Dir(YearDir, vbDirectory) = "" Then
        MkDir YearDir
        Else
        End If
' Creates a folder for the current Quarter if one does not exist
    Dim QuarterDir As String
        QuarterDir = "C:\Users\sprag\Desktop\Invoice Test\" & Format(Now, "yyyy") & "\Q" & Format(Now, "q") & "\"
        If Dir(QuarterDir, vbDirectory) = "" Then
        MkDir QuarterDir
        Else
        End If
  
    For Each Vendor In VendorList
        Debug.Print Vendor.Value
        SubmissionForm.Range("B3") = Vendor
        
                    
                       
        fName = Vendor.Value & "_Q" & Quarter.Value & "_Submission"
        SubmissionForm.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\sprag\Desktop\Invoice Test\" & Format(Now, "yyyy") & "\Q" & Format(Now, "q") & "\" & fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    Next Vendor
    
    
End Sub

 

[JLGWhiz]

Here is a sample of using the Union method to copy non-contiguous cells.

Sub t()
Dim c As Range, rng As Range
For Each c In Intersect(Range("A:A"), ActiveSheet.UsedRange)
    Set rng = Union(Range("A" & c.Row), Range("B" & c.Row), Range("E" & c.Row))
    rng.Copy Cells(Rows.Count, 2).End(xlUp)(3)
Next
End Sub

So long as the cells to be copied are on the same row or in the same column, the Union method will work. But if rows or columns are staggered to form the range, then the Union method fails and you would have to use a loop in cobination with an array, or similar.