title: Merge specific cells from columns from multiple files to one sheet
body: <p>I am trying to merge data from particular columns from multiple csv files. This thread: <a href="https://stackoverflow.com/questions/25219350/excel-vba-merge-specific-columns-from-multiple-files-to-one-sheet">Excel VBA - Merge specific columns from multiple files to one sheet</a> worked for whole ranges of columns. However, I want to copy e.g. each 100th cell from particular column (instead of whole column as it is at the moment).</p>
  
  <p>I have tried to modify the code as per below method 1 and 2 (see **** notes).</p>
  
  <p>This VBA is to go through datalog files which have time stamps in rows and parameters for each time stamp. However, I don't want all parameters, only selected ones (per columns) and in each 100th row.</p>
  
  <pre><code>'takes worksheet and returns last row
  Private Function LastRowUsed(sh As Worksheet) As Long
      On Error Resume Next
      LastRowUsed = sh.Cells.Find(What:="*", _
                      After:=sh.Range("A1"), _
                      LookAt:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
       On Error GoTo 0
   End Function
  
  
  'takes worksheet and returns last column
  Private Function LastColUsed(sh As Worksheet) As Long
      On Error Resume Next
      LastColUsed = sh.Cells.Find(What:="*", _
                      After:=sh.Range(A1), _
                      LookAt:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByColumns, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Column
      On Error GoTo 0
  End Function
  
  
  'takes worksheet and returns last row in column
  Private Function LastRowUsedbyCol(sh As Worksheet, ByVal Col As String) As Long
      On Error Resume Next
      LastRowUsed = sh.Cells.Find(What:="*", _
                      After:=sh.Range(Cell(Col, 1), Cell(Col, 1)), _
                      LookAt:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
      On Error GoTo 0
  End Function
  
  
  
  Function GetFileListArray() As String()
      Dim fileDialogBox As FileDialog
      Dim SelectedFolder As Variant
      Dim MYPATH As String
      Dim MYFILES() As String
      Dim FILESINPATH
      Dim FNUM, i As Integer
      '''''
      Set fileDialogBox = Application.FileDialog(msoFileDialogFolderPicker)
  
      'Use a With...End With block to reference the FileDialog object.
      With fileDialogBox
          If .Show = -1 Then 'the user chose a folder
              For Each SelectedFolder In .SelectedItems
                  MYPATH = SelectedFolder 'asign mypath to the selected folder name
                  'MsgBox "The path is:" &amp; SelectedFolder, vbInformation 'display folder selected
              Next SelectedFolder
          'The user pressed Cancel.
          Else
              MsgBox "Cancel was pressed or Invalid folder chosen, ending macro"
              Exit Function
          End If
      End With
      'Set the file dialog object variable to Nothing to clear memory
      Set fileDialogBox = Nothing
      If Right(MYPATH, 1) &lt;&gt; "\" Then
          MYPATH = MYPATH &amp; "\"
      End If
      FILESINPATH = Dir(MYPATH &amp; "*.csv")
      'MsgBox FILESINPATH
      If FILESINPATH = "" Then
           MsgBox "No files found"
           Exit Function
      End If
  
      'Fill the array(myFiles)with the list of Excel files in the folder
      FNUM = 0
      Do While FILESINPATH &lt;&gt; ""
          FNUM = FNUM + 1
          ReDim Preserve MYFILES(1 To FNUM)
          MYFILES(FNUM) = MYPATH &amp; FILESINPATH
          FILESINPATH = Dir()
      Loop
  
      GetFileListArray = MYFILES()
  End Function
  
  
  
  Sub RFSSearchThenCombine()
  'search first worksheet in files opened, change to search other worksheets
  Const SHEET_TO_SEARCH = 1
  
  Dim FileList() As String
  Dim CurrentFolder As String
  Dim openedWorkBook As Workbook, HeadingWorkbook As Workbook
  Dim OpenedWorkSheet As Worksheet, HeadingWorkSheet As Worksheet
  Dim i, counter, x, j As Integer
  Dim LRowHeading, LRowOpenedBook, LColHeading, LColOpenedBook, LRowHeadingC As Long
  Dim dict As dictionary
  Dim searchValue
  'set original workbook with headings to retrieve
  Set HeadingWorkbook = ActiveWorkbook
  Set HeadingWorkSheet = HeadingWorkbook.Sheets(1)
  'find last column on heading worksheet
  LColHeading = LastColUsed(HeadingWorkSheet)
  
  'create dictionary to link headers to position in heading worksheet
  
  Set dict = CreateObject("Scripting.Dictionary")
  For x = 1 To LColHeading
      dict.Add HeadingWorkSheet.Cells(1, x).Value, x
  Next x
  
  FileList() = GetFileListArray()
  
  For counter = 1 To UBound(FileList)
      Set openedWorkBook = Workbooks.Open(FileList(counter))
      Set OpenedWorkSheet = openedWorkBook.Sheets(SHEET_TO_SEARCH)
      LColOpenedBook = LastColUsed(openedWorkBook.Sheets(1))
      LRowOpenedBook = LastRowUsed(openedWorkBook.Sheets(1))
      LRowHeading = LastRowUsed(HeadingWorkSheet)
  
      For i = 1 To LColOpenedBook 'search headers from a1 to last header
          searchValue = OpenedWorkSheet.Cells(1, i).Value 'set search value in to current header
          If dict.Exists(searchValue) Then
  
              ' *** code from previous thread
              'OpenedWorkSheet.Range(OpenedWorkSheet.Cells(1, i), _
              'OpenedWorkSheet.Cells(LRowOpenedBook, i)).Copy _
              '(HeadingWorkSheet.Cells(LRowHeading, dict.Item(searchValue)))
  
              '**** my proposal
              For j = 1 To LRowOpenedBook Step 100
                  OpenedWorkSheet.Range(OpenedWorkSheet.Cells(j, i), _
                  OpenedWorkSheet.Cells(j, i)).Copy _
                  (HeadingWorkSheet.Cells(LRowHeading + 1, dict.Item(searchValue)))
                  LRowHeading = LRowHeading + 1
  
              '**** my 2nd  proposal
              'LRowHeadingC = HeadingWorkSheet.Cells(Rows.Count, i).End(xlUp).Row
              'For j = 1 To LRowOpenedBook Step 100
                  ' OpenedWorkSheet.Range(OpenedWorkSheet.Cells(j, i), _
                  'OpenedWorkSheet.Cells(j, i)).Copy _
                  '(HeadingWorkSheet.Cells(LRowHeadingC + 1, dict.Item(searchValue)))
                  'LRowHeadingC = LRowHeadingC + 1
  
              Next j
  
          End If
      Next i
      openedWorkBook.Close (False)
  Next counter ' move on to next file
  
  End Sub
  </code></pre>
  
  <p>1st method (when working) results in shift of rows from next columns (all pasted data start from last row (not last row in particular column), it more less results in below pattern (where cl is for column and x represents data):</p>
  
  <pre><code>cl1  cl2  cl3  cl3
  x
  x
  x     
        x
        x
        x    
             x
             x
             x     x
                   x
                   x
  
  x
  x
  x
  </code></pre>
  
  <p>While I want to receive below pattern:</p>
  
  <pre><code>cl1  cl2  cl3  cl3
  x    x    x    x
  x    x    x    x
  x    x    x    x
  </code></pre>
  
  <p>Another question is how should I modify function: LastRowUsed not to start from A1, but e.g. from B1, etc.? I tried to resolve that with Method 2.</p>