Private Sub CommandButton1_Click()
Dim directory, xx, yy As String, fileName As String, sheet As Worksheet, i, z1, z2 As Integer, j As Integer
Dim fDialog
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yy = ActiveWorkbook.Name
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
fDialog.Title = "Select Data folder"
fDialog.InitialFileName = "C:\"
If fDialog.Show = -1 Then
xx = fDialog.SelectedItems(1)
directory = "" & xx & "\" & ""
fileName = Dir(directory & "*.csv")
End If
Do While fileName <> ""
Workbooks.Open (directory & fileName)
z1 = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A2:c" & z1).Copy
Windows(yy).Activate
z2 = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
If z2 <= 2 Then z2 = 2
Range("A" & z2).Select
ActiveSheet.Paste
Workbooks(fileName).Close
fileName = Dir()
Loop
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub CommandButton1_Click()
Dim directory, xx, yy As String, fileName As String, sheet As Worksheet, i, z1, k1 As Integer, j As Integer
Dim fDialog
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yy = ActiveWorkbook.Name
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
fDialog.Title = "Select Data folder"
fDialog.InitialFileName = "C:\"
If fDialog.Show = -1 Then
xx = fDialog.SelectedItems(1)
directory = "" & xx & "\" & ""
fileName = Dir(directory & "*.csv")
End If
Do While fileName <> ""
Workbooks.Open (directory & fileName)
z1 = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A1:c" & z1).Copy
Windows(yy).Activate
k1 = Application.WorksheetFunction.CountA(Sheet1.Range("1:1")) + 1
Cells(1, k1).Select
ActiveSheet.Paste
Workbooks(fileName).Close
fileName = Dir()
Loop
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
کامنت