Excel VBA – Modifica il codice in modo che i dati trasferiti dal foglio 'Fattura' al foglio 'Libro di vendita' si salva in una cartella di lavoro diversa

Ho questo codice, che invia i dati dalla scheda "Fattura" al foglio "Libro di vendita", ma dopo una considerazione, è utile che i dati vengano inviati totalmente a una nuova cartella di lavoro. Come faccio a implementare questo metodo utilizzando il codice qui sotto (in quanto mi ha portto età per arrivare a questo punto!). Ecco il codice: Questa è stata la domanda originale. Ora è completamente risolto e aggiornato sotto-

Il codice qui sotto funziona. L'ultimo problema da risolvere è il fatto che i dati copiati copiano anche le righe di elementi vuoti. Ho trovato una soluzione semplice per questo che copierò il codice qui sotto. È fondamentalmente un codice vba auto run che elimina una row se non ci sono dati in una certa cella. Grazie per l'aiuto. Mi sento invincibile!

  • Utilizzando una VBA per loop per concantenare la colonna in excel
  • Esportre .NET DataTable a Microsoft Excel e formattare i risultati
  • Excel VBA - Come pivot il risultato di sql
  • Pivot Chart - Creare un barra di count o un grafico a torta in Excel 2010?
  • Utilizzo del separatore di virgole nel file di output di Excel - C # webform
  • Esportre foglio da Excel a CSV
  • Sub sendtosales() Dim WB As Workbook '''! Dim CurrentWB As Workbook '''! Dim WBLoc As String '''! Dim rng As Range Dim i As Long Dim a As Long Dim rng_dest As Range Application.ScreenUpdating = False WBLoc = "C:\Salestracker.xlsm" '''! Location of the workbook, trimmed down for public view Set CurrentWB = Excel.ThisWorkbook '''! Set WB = Workbooks.Open(WBLoc) '''! Opens the workbook i = 1 Set rng_dest = WB.Sheets("Salestracker").Range("D:F") '''! Change Sheets() to whichever sheet you want to use ' Find first empty row in columns D:F on sheet Sales Book Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0 i = i + 1 Loop 'Copy range A23:D27 on sheet Invoice to Variant arrays Set rng = CurrentWB.Sheets("Invoice").Range("A23:D27") '''! ' Copy rows containing values to sheet Sales Book For a = 1 To rng.Rows.Count If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then rng_dest.Rows(i).Value = rng.Rows(a).Value With WB.Sheets("Salestracker") '''! Change Sheets() to whichever sheet you want to use 'Copy Invoice number .Range("B" & i).Value = CurrentWB.Sheets("Invoice").Range("C18").Value '''! 'Copy Date .Range("A" & i).Value = CurrentWB.Sheets("Invoice").Range("C15").Value '''! 'Copy Company name .Range("C" & i).Value = CurrentWB.Sheets("Invoice").Range("A7").Value '''! End With '''! i = i + 1 End If Next a WB.Close savechanges:=True '''! This wil close the Workbook and save changes Set WB = Nothing '''! Cleaning memory Set CurrentWB = Nothing '''! Cleaning memory Application.ScreenUpdating = True End Sub 

    Immagine di fattura e Salestracker con commenti in rosso, e il problema di bit su saletracker sono grigi-out

    Ecco il codice che elimina le righe che non dispongono di dati in una certa cella, F nel mio caso-

     Sub killemptyF() On Error Resume Next Columns("F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub Su errore riprendere successivo Sub killemptyF() On Error Resume Next Columns("F").SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub 

    e qui è il codice per eseguire automaticamente questo module each volta che viene aperta la cartella di lavoro,

     Sub Auto_Run() Run ("killemptyF") End Sub 

  • i dati persi durante la lettura di file xls
  • Excel Macro mantiene la creazione di nuovi componenti vuoti quando si fa clic su quello esistente da eseguire
  • Colbind un ascoltatore a una cella e get un'exception "fuori memory"
  • Approccio efficiente di sum
  • Come estrarre informazioni da crunchbase
  • Testo multiline nelle celle di Excel
  • One Solution collect form web for “Excel VBA – Modifica il codice in modo che i dati trasferiti dal foglio 'Fattura' al foglio 'Libro di vendita' si salva in una cartella di lavoro diversa”

    Qualcosa di simile dovrebbe funzionare. Tutto quello che ho aggiunto / modificato ho contrassegnato con '''! .

     Sub sendtosales() Dim WB as Workbook '''! Dim CurrentWB as Workbook '''! Dim WBLoc as String '''! Dim rng As Range Dim i As Long Dim a As Long Dim rng_dest As Range Application.ScreenUpdating = False WBLoc = "C:\Documents\Salestracker.xlsm" '''! Location of the workbook Set CurrentWB = Excel.ThisWorkbook '''! Set WB = Workbooks.Open(WBLoc) '''! Opens the workbook i = 1 Set rng_dest = WB.Sheets(1).Range("D:F") '''! Change Sheets() to whichever sheet you want to use ' Find first empty row in columns D:F on sheet Sales Book Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0 i = i + 1 Loop 'Copy range A23:D27 on sheet Invoice to Variant arrays Set rng = CurrentWB.Sheets("Invoice").Range("A23:D27") '''! ' Copy rows containing values to sheet Sales Book For a = 1 To rng.Rows.Count If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then rng_dest.Rows(i).Value = rng.Rows(a).Value With WB.Sheets(1) '''! Change Sheets() to whichever sheet you want to use 'Copy Invoice number .Range("B" & i).Value = CurrentWB.Sheets("Invoice").Range("C18").Value '''! 'Copy Date .Range("A" & i).Value = CurrentWB.Sheets("Invoice").Range("C15").Value '''! 'Copy Company name .Range("C" & i).Value = CurrentWB.Sheets("Invoice").Range("A7").Value '''! End With '''! i = i + 1 End If Next a WB.Close savechanges:=True '''! This wil close the Workbook and save changes Set WB = Nothing '''! Cleaning memory Set CurrentWB = Nothing '''! Cleaning memory Application.ScreenUpdating = True End Sub 
    Microsoft Office Excel Spreadsheet è il miglior software di Office, Excel VBA e formule Excel rendono il foglio di calcolo più veloce.