none
Can anyone help me write a code about coping data from many files and paste them to one file !? RRS feed

  • Question

  • Hello ! 

    As I said in title , I have alot files (e.g. 60 files) and I want to write a code to copy 5 columns (for examples) of special sheet of files and paste them in one file respectively. For perceive it I explained it more below .

    Suppose one of my files is simplified as this : http://s000.tinyupload.com/?file_id=00699705919876414523

    The name of  this file is 2006Oct and assume my excel files are like "2006Oct, 2006Nov,2006Dec,2007Jan ... 2010Dec". At first I should go to "my files" sheet of 2006Oct file and copy columns " A,B,C,D,E,F " that has "PerturbationNumber=1" respectively and then paste these to a file that is output file and repeat this process for the other files ( 2006Nov and etc ) and paste data in output file sequentially. 

    I appreciate and look foreward for any help in this issue.

    Majid

    Monday, January 26, 2015 11:47 AM

Answers

  • Try code below

    Sub CombineBooks()
    
    Dim wb As Workbook
    Dim sourceSht As Worksheet
    Dim destSht As Worksheet
    Set destSht = ThisWorkbook.Sheets(1)
    destSht.Cells.Clear
    FolderName = "C:\temp\test\"
    
    file = Dir(FolderName & "*.xlsx")
    firstSht = True
    Do While file <> ""
      Set wb = Workbooks.Open(Filename:=FolderName & file, ReadOnly:=True)
      Set sourceSht = wb.Sheets(1)
      With sourceSht
         sourceLastRow = .Range("A" & Rows.Count).End(xlUp).Row
         If .Cells.AutoFilter Then
            .Cells.AutoFilter 'turn off autofilter
         End If
         .Cells.AutoFilter Field:=6, Criteria1:="1"
      
         If firstSht = True Then
           Set copyRange = .Range("A1", .Range("E" & sourceLastRow)).SpecialCells(xlCellTypeVisible)
           destSht.Range("F1") = "FileName"
           firstSht = False
           destNewRow = 1
         Else
           Set copyRange = .Range("A2", .Range("E" & sourceLastRow)).SpecialCells(xlCellTypeVisible)
           destNewRow = destSht.Range("A" & Rows.Count).End(xlUp).Row + 1
         End If
         
         
         copyRange.Copy Destination:=destSht.Range("A" & destNewRow)
         LastRow = destSht.Range("A" & Rows.Count).End(xlUp).Row
         If destNewRow = 1 Then
            destSht.Range("F2:F" & LastRow) = file
         Else
            destSht.Range("F" & destNewRow & ":F" & LastRow) = file
         End If
         
      End With
      
      
      
      wb.Close savechanges:=False
      file = Dir()
    Loop
    
    
    End Sub
    


    jdweng

    Tuesday, January 27, 2015 12:50 PM
  • That`s right , but I dont want to run this on first sheet I need to run it on special sheet and copy entire row , because I assess it by perturbation number header. 
    Change
    Set sourceSht = wb.Sheets(1)
    To
    Set sourceSht = wb.Sheets("Name Of Sheet You Want")


    Wednesday, January 28, 2015 4:55 PM
  • I used the worksheet number that you had in sample file.  I think you want to change the destination sheet number in the following line of code

    Set destSht = ThisWorkbook.Sheets(1)

    I open the workbooks as ReadOnly and filter the according to column G.


    jdweng

    Wednesday, January 28, 2015 5:11 PM

All replies

  • Try code below

    Sub CombineBooks()
    
    Dim wb As Workbook
    Dim sourceSht As Worksheet
    Dim destSht As Worksheet
    Set destSht = ThisWorkbook.Sheets(1)
    destSht.Cells.Clear
    FolderName = "C:\temp\test\"
    
    file = Dir(FolderName & "*.xlsx")
    firstSht = True
    Do While file <> ""
      Set wb = Workbooks.Open(Filename:=FolderName & file, ReadOnly:=True)
      Set sourceSht = wb.Sheets(1)
      With sourceSht
         sourceLastRow = .Range("A" & Rows.Count).End(xlUp).Row
         If .Cells.AutoFilter Then
            .Cells.AutoFilter 'turn off autofilter
         End If
         .Cells.AutoFilter Field:=6, Criteria1:="1"
      
         If firstSht = True Then
           Set copyRange = .Range("A1", .Range("E" & sourceLastRow)).SpecialCells(xlCellTypeVisible)
           destSht.Range("F1") = "FileName"
           firstSht = False
           destNewRow = 1
         Else
           Set copyRange = .Range("A2", .Range("E" & sourceLastRow)).SpecialCells(xlCellTypeVisible)
           destNewRow = destSht.Range("A" & Rows.Count).End(xlUp).Row + 1
         End If
         
         
         copyRange.Copy Destination:=destSht.Range("A" & destNewRow)
         LastRow = destSht.Range("A" & Rows.Count).End(xlUp).Row
         If destNewRow = 1 Then
            destSht.Range("F2:F" & LastRow) = file
         Else
            destSht.Range("F" & destNewRow & ":F" & LastRow) = file
         End If
         
      End With
      
      
      
      wb.Close savechanges:=False
      file = Dir()
    Loop
    
    
    End Sub
    


    jdweng

    Tuesday, January 27, 2015 12:50 PM
  • Excuse me but it does not work for me , and I want to write another code and I have a quick question .

    Can you help how to find value in a special column and copy all rows that match to it !? 

    Wednesday, January 28, 2015 10:19 AM
  • I downloaded your sample xlsx file and tested the code by make 4 copies of the sample file.  I know the code works. You need to change the folder name and make sure the folder name ends with a backslash. The code uses autofilter to find values in field 6 (column G); and then uses cell type xlCellTypeVisible to copy all the visible rows after applying autofilter.

    jdweng

    Wednesday, January 28, 2015 1:04 PM
  • That`s right , but I dont want to run this on first sheet I need to run it on special sheet and copy entire row , because I assess it by perturbation number header. 
    Wednesday, January 28, 2015 4:14 PM
  • That`s right , but I dont want to run this on first sheet I need to run it on special sheet and copy entire row , because I assess it by perturbation number header. 
    Change
    Set sourceSht = wb.Sheets(1)
    To
    Set sourceSht = wb.Sheets("Name Of Sheet You Want")


    Wednesday, January 28, 2015 4:55 PM
  • I used the worksheet number that you had in sample file.  I think you want to change the destination sheet number in the following line of code

    Set destSht = ThisWorkbook.Sheets(1)

    I open the workbooks as ReadOnly and filter the according to column G.


    jdweng

    Wednesday, January 28, 2015 5:11 PM