Microsoft Excel에서 VBA를 사용하여 폴더에있는 각 통합 문서의 범위를 복사
이 문서에서는 폴더의 여러 통합 문서에서 새 통합 문서로 데이터를 복사하는 매크로를 만듭니다.
두 개의 매크로를 만들 것입니다. 하나의 매크로는 첫 번째 열의 레코드 만 새 통합 문서로 복사하고 두 번째 매크로는 모든 데이터를 여기에 복사합니다.
이 예의 원시 데이터는 직원의 출석 기록으로 구성됩니다.
TestFolder에는 여러 Excel 파일이 있습니다. Excel 파일의 파일 이름은 “ddmmyyyy”형식으로 특정 날짜를 나타냅니다.
각 Excel 파일에는 특정 날짜에 참석 한 직원의 날짜, 직원 ID 및 직원 이름이 포함되어 있습니다.
두 개의 매크로를 만들었습니다. “CopyingSingleColumnData”및“CopyingMultipleColumnData”. “CopyingSingleColumnData”매크로는 폴더에있는 모든 파일의 첫 번째 열에서 새 통합 문서로 레코드 만 복사합니다. “CopyingMultipleColumnData”매크로는 폴더의 모든 파일에서 새 통합 문서로 모든 데이터를 복사합니다.
“CopyingSingleColumnData”매크로는“Copying Single Column”버튼을 클릭하여 실행할 수 있습니다. “CopyingMultipleColumnData”매크로는“Copying Multiple Columns”버튼을 클릭하여 실행할 수 있습니다.
매크로를 실행하기 전에 텍스트 상자에 Excel 파일이있는 폴더의 경로를 지정해야합니다.
“Copying Single Column”버튼을 클릭하면 정의 된 폴더에 새로운 워크 북“ConsolidatedFile”이 생성됩니다.이 워크 북은 폴더에있는 모든 파일의 첫 번째 열에서 통합 된 데이터를 포함합니다.
새로운 워크 북이 생성됩니다. 첫 번째 열에는 레코드 만 포함됩니다. 통합 된 데이터가 있으면 날짜 수를 계산하여 특정 날짜에 참석 한 직원 수를 찾을 수 있습니다. 특정 날짜의 수는 해당 특정 날짜에있는 직원 수와 같습니다. 일.
“복수 열 복사”버튼을 클릭하면 정의 된 폴더에 새로운 통합 문서“ConsolidatedAllColumns”가 생성됩니다. 이 통합 문서에는 폴더에있는 모든 파일의 모든 레코드에서 통합 된 데이터가 포함됩니다.
생성 된 새 통합 문서에는 폴더에있는 모든 파일의 모든 레코드가 포함됩니다. 통합 된 데이터가 있으면 모든 출석 세부 정보를 단일 파일로 사용할 수 있습니다. 특정 날짜에 참석 한 직원의 수를 쉽게 찾을 수 있으며 해당 날짜에 참석 한 직원의 이름도 얻을 수 있습니다.
코드 설명
Sheet1.TextBox1.Value 위 코드는 시트“Sheet1”에서 텍스트 상자“TextBox1”에 삽입 된 값을 가져 오는 데 사용됩니다.
Dir (FolderPath & “* .xlsx”)
위 코드는 파일 확장자가“.xlsx”인 파일 이름을 가져 오는 데 사용됩니다. 여러 문자 파일 이름에 와일드 카드 *를 사용했습니다.
동안 파일 이름 <> “”
Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = 파일 이름 FileName = Dir ()
Wend Above 코드는 폴더에있는 모든 파일의 파일 이름을 가져 오는 데 사용됩니다.
For i = 1 To UBound (FileArray)
다음 위의 코드는 폴더의 모든 파일을 반복하는 데 사용됩니다.
Range ( “A1”, Cells (LastRow, 1)). Copy DestWB.ActiveSheet.Cells (LastDesRow, 1)
위의 코드는 첫 번째 열의 레코드를 대상 통합 문서로 복사하는 데 사용됩니다.
Range ( “A1”, ActiveCell.SpecialCells (xlCellTypeLastCell)). Copy DestWB.ActiveSheet.Cells (LastDesRow, 1)
위의 코드는 활성 통합 문서의 모든 레코드를 대상 통합 문서로 복사하는 데 사용됩니다.
아래 코드를 따르세요
Option Explicit
Sub CopyingSingleColumnData()
'Declaring variables
Dim FileName, FolderPath, FileArray(), FileName1 As String
Dim LastRow, LastDesRow, Count1, i As Integer
Dim SourceWB, DestWB As Workbook
Application.ScreenUpdating = False
FolderPath = Sheet1.TextBox1.Value
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying the first column to last row in the destination workbook
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Else
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1)
End If
SourceWB.Close False
Next
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Sub CopyingMultipleColumnData()
'Declaring variables
Dim FileName, FolderPath, FileArray(), FileName1 As String
Dim LastRow, LastDesRow, Count1, i As Integer
Dim SourceWB, DestWB As Workbook
Application.ScreenUpdating = False
FolderPath = Sheet1.TextBox1.Value
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying all data in the worksheet to last row in the destination workbook
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Else
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1)
End If
SourceWB.Close False
Next
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedAllColumns.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
이 블로그가 마음에 들면 Facebook 및 Facebook에서 친구들과 공유하십시오.
여러분의 의견을 듣고 싶습니다. 작업을 개선하고 더 나은 서비스를 제공 할 수있는 방법을 알려주십시오. [email protected]로 문의 해주세요