Consulting

Results 1 to 2 of 2

Thread: Transfer data from one work to another

  1. #1

    Transfer data from one work to another

    Excel Questions
    Find bottlenecks in your Excel workbooks

    hi,

    I have a macro that will send multiple emails to my suppliers as an attachment and the attachment only includes information that relates to them. I am wondering if someone could tweak it so it will pull data from another workbook and paste it into the main worksheet before the macro sends the worksheet.

    i would like the macro to pull specific columns from workbook "a" worksheet "a" and input it into my main workbook "b" worksheet "b" then send the worksheet "b" then send the emails with the attachments.

    the columns i need from worksheet "a", starting from row 2 are the following, A,H,D,E,J,L,M,V,W,N,O,P,X,Y and i would like them to go in worksheet "b" starting from row2 A,B,C,D,E,F,G,H,I,J,K,L,M,N. the macro should not take any data from row 1 because the header is in that row.

    i would also need all blank cells in column M in worksheet "b" filled in with "reconfirm delivery date" and any blank cells in column N in worksheet "b" with the data that is in column J from the specific row.

    here is my current Macro

    Sub test20221130B()
    Dim rng As Range, c As Range, AddrRange As Range
    Dim i As Long, lastRow As Long, lastRow2 As Long
    Dim targetWorkbook As Workbook
    Dim objFSO As Object
    Dim varTempFolder As Variant, v As Variant
    Dim AttFile As String, Dest As String
    Dim sh As Worksheet, shMail As Worksheet
    Set sh = Sheets("order book")
    Set shMail = Sheets("Sheet2")
    lastRow = sh.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lastRow2 = shMail.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set AddrRange = shMail.Range("A1:B" & lastRow2)
    v = sh.Range("A2:v" & lastRow).Value
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    varTempFolder = objFSO.GetSpecialFolder(2).Path & "\Temp " & Format(Now, "dd-mm-yyyy- hh-mm-ss")
    objFSO.CreateFolder (varTempFolder)
    Application.ScreenUpdating = False
    With CreateObject("scripting.dictionary")
         For i = 2 To UBound(v)
             If Not .exists(v(i, 2)) Then
                .Add v(i, 2), Nothing
                With sh
                      sh.Range("A1").AutoFilter 2, v(i, 2)
                      Set rng = .AutoFilter.Range
                      Set targetWorkbook = Workbooks.Add
                      .UsedRange.SpecialCells(xlCellTypeVisible).Copy
                      With targetWorkbook.Worksheets(Sheets.Count)
                           .Range("A1").PasteSpecial xlPasteColumnWidths
                           .Range("A1").PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                           .Range("A1").PasteSpecial xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                      End With
                      AttFile = v(i, 2) & ".xlsx"
                      Dest = Application.WorksheetFunction.VLookup(v(i, 2), AddrRange, 2, False)
                     With targetWorkbook
                          '.ActiveSheet.Columns.AutoFit
                           .SaveAs varTempFolder & "" & AttFile
                           .Close
                    End With
                   With CreateObject("Outlook.Application").CreateItem(0)
                        .To = Dest
                        .Subject = "Subject"
                        .Body = "Please find the attached order book. please fill in the column that applies to you"
                        .Attachments.Add varTempFolder & "" & AttFile
                        .display 'to show
                        '.Send 'to send
                  End With
            End With
       End If
    Next i
    End With
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
    objFSO.deletefolder (varTempFolder)
    End Sub
    Last edited by Aussiebear; 01-23-2023 at 03:47 PM. Reason: Added code tags to supplied code

  2. #2
    VBAX Mentor
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    323
    Location
    Please post code between CODE tags to retain indentation and readability.

    Is this code attempting to accomplish what you want? What is wrong with code - error message, wrong result, nothing happens? Have you step-debugged?

    You could provide file for analysis. Follow instructions at bottom of my post.
    How to attach file: How to upload your attachments (vbaexpress.com) To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •