0

I am very new to the world of Excel VBA World, I am currently working on merging multiple worksheets from different .csv files (same folder) into one giant .csv file.

Previously, I have already ran a code (successfully) to select all the data I wanted to all the .csv files in that folder. But I can't seem to merge all the sheets from these files into one....

This is the successful code

Option Explicit

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.csv*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
                OP10SelectCut
            End With
            xFileName = Dir
        Loop
    End If
End Sub


Sub OP10SelectCut()
'
' OP10SelectCut 巨集
'
'
Dim TotalRow As Integer

TotalRow = Range("B1").End(xlDown).Row
        
    Columns("B:B").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
        Formula1:="=-0.02", Formula2:="=0.02"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.AutoFilter
    ActiveSheet.Range("$B$1:$B$" & TotalRow).AutoFilter Field:=1, Criteria1:=RGB(255 _
        , 255, 0), Operator:=xlFilterCellColor
    Columns("B:C").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Range("A1").Select
    ActiveSheet.Paste
End Sub
This is the not working code
'合併多個Excel檔案
Sub GetSheets()
Path = "C:\Users\andrew-wu\Desktop\OP10TestBatch"
Filename = Dir(Path & "*.csv*")
  Do While Filename <> "*.csv*"
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
  '只複製第一個Sheet
  If ActiveWorkbook.Sheets.Count > 0 Then
    ActiveWorkbook.Sheets(1).Copy _
        After:=ThisWorkbook.Sheets(1)
  '每個Sheet都複製
  'For Each Sheet In ActiveWorkbook.Sheets
    'Sheet.Copy After:=ThisWorkbook.Sheets(1)
  'Next Sheet
  End If

     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub
halfer
  • 19,824
  • 17
  • 99
  • 186
Wu Andrew
  • 3
  • 2
  • Have a look at how I moved sheets around, give it a vote if it helps: https://stackoverflow.com/q/30575923/4961700 – Solar Mike Jul 15 '20 at 07:45
  • Hi Mike, thanks for the reply! After reading the post and customized your solution to mine (as csv files), I have encountered errors regarding (subscript out of range) – Wu Andrew Jul 15 '20 at 08:16

0 Answers0