Copy paste from multiple Excel and Csv files to another excel file VBA

youbitto

New Member
Joined
Jun 8, 2022
Messages
35
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
Hello
I have Multiple CSV, XLS and XLSX files that I want to import into one sheets with the option to select the files

For example I have the Source files :

1. FMS.xls with columns (A , B, D, F, G, N) and the sheet is called "tableFacture"
2. HT.csv with columns (A, C, D , E, L, S) with "," separator and the sheet is called "Liste_des_factures hta"

For destination File "Port.xlsm" I want the source files to be pasted in a specific order (the sheet is called "Port")

for FMS.xls : (A to A), (B to B), (D to C), (F to G), (G to D), (N to E)
for HT.csv : (A to A), (C to B), (D to C) , (E to G), (L to D), (S to E)

The Column F in Port.xlsm I want it to be filled with "FMS" for the data imported from FMS.xls and "HT" for the data imported from HT.csv


I tried doing this on my own but nothing worked since I lack the knowledge and still starting VBA

FMS.xls

FMS.xls
ABCDEFGHIJKLMNO
1N° MemoireCode FMSCode ClientIntitule ClientTypeCategorie clientDate facturationDate presentationDate réglementDate AcompteStatutStatut (Paiement)Statut presentationMontant TTCActions
293210900002393004799300479SKTMMoraleSecteur Economique12/10/2021NON_REGLEC_NON_REGLE<br/>Non reglé (CTC)affectee non présenté796.6500
393210900003093003689300368KASMA F L NMoraleAdministration12/10/2021NON_REGLEC_NON_REGLE<br/>Non reglé (CTC)affectee non présenté82364.2300
493210900004393002319300231AIR ALGERIE ADRARMoraleAdministration12/10/2021NON_REGLEC_NON_REGLE<br/>Non reglé (CTC)affectee non présenté25548.7900
593211100002793006649300664LE DIRECT.ACTION SOCIALE ADRARMoraleAdministration12/12/2021NON_REGLEC_NON_REGLE<br/>Non reglé (CTC)affectee non présenté18114.4300
693210600005193005599300559D E P ADRARMoraleAdministration19/07/2021NON_REGLEC_NON_REGLE<br/>Non reglé (CTC)affectee non présenté137537.2700
tableFacture



HT.csv
HT.csv
ABCDEFGHIJKLMNOPQRST
1N° factureN° ContratCode ClientIntitule ClientCategorieTraiteAffectationStatut presentationStatutStatut paiementEtatDate facturationDate presentationDate encaissement en attente de validationDate retablissementDate réglementDate AcompteDate annulationMontant TTCActions
2932202A000739314653E19989391354MENUISERIE GRL MOULAY OMAR MEDSecteur EconomiqueNonNonRemisnon réglé<br/>C_NON_REGLE<br/>Non reglé (CTC)Fraîche02/03/20223637.0800org.primefaces.component.commandbutton.CommandButton@aef61a0
3932111A011839350227E20159392471PICINE 25 M3 ZT KOUNTAAdministrationNonNonaffectee non présenténon réglé<br/>C_NON_REGLE<br/>Non reglé (CTC)Fraîche02/12/202129074.3700org.primefaces.component.commandbutton.CommandButton@aef61a0
4932408A013059360350E20149391770APC TAMANTITAdministrationNonNonnon présenténon réglé<br/>C_NON_REGLE<br/>Non reglé (CTC)Fraîche02/09/202446435.4400org.primefaces.component.commandbutton.CommandButton@aef61a0
5932408A004819315068E20209320A000060Forage agricole N° 04 O/Ghozala Timmi AdrarSecteur EconomiqueNonNonnon présenténon réglé<br/>C_NON_REGLE<br/>Non reglé (CTC)Fraîche02/09/2024148594.8000org.primefaces.component.commandbutton.CommandButton@aef61a0
Liste_des_factures hta




Port.xlsx
Port.xlsm
ABCDEFG
12
13N° MemoireCode ClientIntitule ClientDate facturationMontant TTCenerCategorie
14
15
16
17
Port
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Try this macro.

For destination File "Port.xlsm"

The line Set destWb = Workbooks.Open(ThisWorkbook.Path & "\Port.xlsm") opens "Port.xlsm" (in the same folder as the macro workbook) if it isn't already open.

VBA Code:
Public Sub Import_Files()

    Dim selectedFiles As Variant
    Dim sourceWb As Workbook, destWb As Workbook
    Dim destSheet As Worksheet
    Dim file As Variant
    Dim nextRow As Long, numRows As Long
   
    selectedFiles = Application.GetOpenFilename(MultiSelect:=True, FileFilter:="Excel and CSV Files,*.xlsx;*.xls;*.csv", Title:="Select files to import")
    If VarType(selectedFiles) = vbBoolean Then Exit Sub  'Cancel clicked
   
    Application.ScreenUpdating = False
    
    Set destWb = Workbooks.Open(ThisWorkbook.Path & "\Port.xlsm")
    Set destSheet = destWb.Worksheets("Port")
    
    With destSheet
        nextRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With

    For Each file In selectedFiles
    
        Set sourceWb = Workbooks.Open(file, ReadOnly:=True)
        
        Select Case Mid(file, InStrRev(file, "."))
        
            Case ".xlsx", ".xls"
            
                'for FMS.xls : (A to A), (B to B), (D to C), (F to G), (G to D), (N to E)
                'Column F filled with "FMS"
               
                With sourceWb.Worksheets("tableFacture")
                    numRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                    .Range("A2").Resize(numRows).Copy destSheet.Cells(nextRow, "A")
                    .Range("B2").Resize(numRows).Copy destSheet.Cells(nextRow, "B")
                    .Range("D2").Resize(numRows).Copy destSheet.Cells(nextRow, "C")
                    .Range("F2").Resize(numRows).Copy destSheet.Cells(nextRow, "G")
                    .Range("G2").Resize(numRows).Copy destSheet.Cells(nextRow, "D")
                    .Range("N2").Resize(numRows).Copy destSheet.Cells(nextRow, "E")
                    destSheet.Cells(nextRow, "F").Resize(numRows).Value = "FMS"
                    nextRow = nextRow + numRows
                End With
                
            Case ".csv"
            
                'for HT.csv : (A to A), (C to B), (D to C), (E to G), (L to D), (S to E)
                'Column F filled with "HT"
           
                With sourceWb.Worksheets(1)
                    numRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                    .Range("A2").Resize(numRows).Copy destSheet.Cells(nextRow, "A")
                    .Range("C2").Resize(numRows).Copy destSheet.Cells(nextRow, "B")
                    .Range("D2").Resize(numRows).Copy destSheet.Cells(nextRow, "C")
                    .Range("E2").Resize(numRows).Copy destSheet.Cells(nextRow, "G")
                    .Range("L2").Resize(numRows).Copy destSheet.Cells(nextRow, "D")
                    .Range("S2").Resize(numRows).Copy destSheet.Cells(nextRow, "E")
                    destSheet.Cells(nextRow, "F").Resize(numRows).Value = "HT"
                    nextRow = nextRow + numRows
                End With
       
        End Select
        
        sourceWb.Close False
            
    Next

    Application.ScreenUpdating = True
    
End Sub
 
Upvote 1
Solution
Try this macro.



The line Set destWb = Workbooks.Open(ThisWorkbook.Path & "\Port.xlsm") opens "Port.xlsm" (in the same folder as the macro workbook) if it isn't already open.

VBA Code:
Public Sub Import_Files()

    Dim selectedFiles As Variant
    Dim sourceWb As Workbook, destWb As Workbook
    Dim destSheet As Worksheet
    Dim file As Variant
    Dim nextRow As Long, numRows As Long
  
    selectedFiles = Application.GetOpenFilename(MultiSelect:=True, FileFilter:="Excel and CSV Files,*.xlsx;*.xls;*.csv", Title:="Select files to import")
    If VarType(selectedFiles) = vbBoolean Then Exit Sub  'Cancel clicked
  
    Application.ScreenUpdating = False
   
    Set destWb = Workbooks.Open(ThisWorkbook.Path & "\Port.xlsm")
    Set destSheet = destWb.Worksheets("Port")
   
    With destSheet
        nextRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With

    For Each file In selectedFiles
   
        Set sourceWb = Workbooks.Open(file, ReadOnly:=True)
       
        Select Case Mid(file, InStrRev(file, "."))
       
            Case ".xlsx", ".xls"
           
                'for FMS.xls : (A to A), (B to B), (D to C), (F to G), (G to D), (N to E)
                'Column F filled with "FMS"
              
                With sourceWb.Worksheets("tableFacture")
                    numRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                    .Range("A2").Resize(numRows).Copy destSheet.Cells(nextRow, "A")
                    .Range("B2").Resize(numRows).Copy destSheet.Cells(nextRow, "B")
                    .Range("D2").Resize(numRows).Copy destSheet.Cells(nextRow, "C")
                    .Range("F2").Resize(numRows).Copy destSheet.Cells(nextRow, "G")
                    .Range("G2").Resize(numRows).Copy destSheet.Cells(nextRow, "D")
                    .Range("N2").Resize(numRows).Copy destSheet.Cells(nextRow, "E")
                    destSheet.Cells(nextRow, "F").Resize(numRows).Value = "FMS"
                    nextRow = nextRow + numRows
                End With
               
            Case ".csv"
           
                'for HT.csv : (A to A), (C to B), (D to C), (E to G), (L to D), (S to E)
                'Column F filled with "HT"
          
                With sourceWb.Worksheets(1)
                    numRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                    .Range("A2").Resize(numRows).Copy destSheet.Cells(nextRow, "A")
                    .Range("C2").Resize(numRows).Copy destSheet.Cells(nextRow, "B")
                    .Range("D2").Resize(numRows).Copy destSheet.Cells(nextRow, "C")
                    .Range("E2").Resize(numRows).Copy destSheet.Cells(nextRow, "G")
                    .Range("L2").Resize(numRows).Copy destSheet.Cells(nextRow, "D")
                    .Range("S2").Resize(numRows).Copy destSheet.Cells(nextRow, "E")
                    destSheet.Cells(nextRow, "F").Resize(numRows).Value = "HT"
                    nextRow = nextRow + numRows
                End With
      
        End Select
       
        sourceWb.Close False
           
    Next

    Application.ScreenUpdating = True
   
End Sub
Wow thank you very much, it worked perfectly I will try to understand what you did, I get it worked with a multiple codes and opening each file separately , a very beginner method but yours is perfect with what I had in mind
 
Upvote 0

Forum statistics

Threads
1,224,539
Messages
6,179,415
Members
452,912
Latest member
alicemil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top