I den här artikeln kommer vi att skapa ett makro för att kopiera data från flera arbetsböcker i en mapp till en ny arbetsbok.
Vi kommer att skapa två makron; ett makro kommer bara att kopiera poster från första kolumnen till den nya arbetsboken och det andra makrot kommer att kopiera all data till den.
Raw data för detta exempel består av närvarojournaler för anställda. I TestFolder har vi flera Excel -filer. Filnamn på Excel -filer representerar ett visst datum i "ddmmyyyy" -format.
Varje Excel -fil innehåller datum, medarbetar -id och medarbetarnamn på de anställda som var närvarande just den dagen.
Vi har skapat två makron; "CopyingSingleColumnData" och "CopyingMultipleColumnData". Makroet "CopyingSingleColumnData" kopierar bara poster från den första kolumnen i alla filer i mappen till den nya arbetsboken. Makroet "CopyingMultipleColumnData" kopierar all data från alla filer i mappen till den nya arbetsboken.
Makroet "CopyingSingleColumnData" kan köras genom att klicka på knappen "Kopiera enkel kolumn". Makroet "CopyingMultipleColumnData" kan köras genom att klicka på knappen "Kopiera flera kolumner".
Innan du kör makrot måste du ange sökvägen till mappen i textrutan, där Excel -filer placeras.
När du klickar på knappen "Kopiera en enda kolumn" skapas en ny arbetsbok "ConsolidatedFile" i den definierade mappen. Denna arbetsbok innehåller konsoliderade data från första kolumnen i alla filer i mappen.
Den nya arbetsboken innehåller endast poster i den första kolumnen. När vi har de konsoliderade uppgifterna kan vi ta reda på antalet anställda som är närvarande på en viss dag genom att räkna antalet datum. Räkningen av ett visst datum kommer att vara lika med antalet anställda som är närvarande den dagen.
När du klickar på knappen "Kopiera flera kolumner" genererar den nya arbetsboken "ConsolidatedAllColumns" i den definierade mappen. Denna arbetsbok innehåller konsoliderade data från alla poster i alla filer i mappen.
Den nya arbetsboken som skapas innehåller alla poster från alla filer i mappen. När vi har den konsoliderade informationen har vi alla närvaroinformationer tillgängliga i en enda fil. Vi kan enkelt hitta antalet anställda närvarande just den dagen och även få namn på de anställda som var närvarande just den dagen.
Kodförklaring
Sheet1.TextBox1.Value
Ovanstående kod används för att få värdet infogat i textrutan "TextBox1" från arket "Sheet1".
Dir (FolderPath & "*.xlsx")
Ovanstående kod används för att få namnet på filen som har filtillägget ".xlsx". Vi har använt jokertecken * för filnamn med flera tecken.
Medan filnamn ""
Count1 = Count1 + 1
ReDim Preserve FileArray (1 att räkna1)
FileArray (Count1) = Filnamn
Filnamn = Dir ()
Wend
Ovanstående kod används för att få filnamn på alla filer i mappen.
För i = 1 till UBound (FileArray)
Nästa
Ovanstående kod används för att gå igenom alla filer i mappen.
Område ("A1", celler (LastRow, 1)). Kopiera DestWB.ActiveSheet.Cells (LastDesRow, 1)
Ovanstående kod används för att kopiera post från den första kolumnen till målarbetsboken.
Område ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopiera DestWB.ActiveSheet.Cells (LastDesRow, 1)
Ovanstående kod används för att kopiera all post från den aktiva arbetsboken till målarbetsboken.
Följ koden nedan
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.TextBox' Infoga backslash i mappvägen om backslash (\) saknas Om Right (FolderPath, 1) "\" Då FolderPath = FolderPath & "\" End If 'Söker Excel -filer 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' Skapa en ny arbetsbok Ställ in DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Hitta den sista raden i arbetsboken LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Öppna Excel -arbetsboken Ställ källaWB = Workbooks.Open (FolderPath & FileArray (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Klistrar in de kopierade data till sista raden i målarbetsboken Om LastDesRow = 1 Sedan' Kopierar den första kolumnen till sista raden i målarbetsboken Område ("A1", Celler (LastRow, 1)). Kopiera DestWB. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Cells (LastRow, 1)). Kopiera DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) Avsluta om SourceWB.Close False Next 'Spara och stäng ett nytt 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, LastDes , Count1, i As Integer Dim SourceWB, DestWB As Workbook Application.ScreenUpdating = False FolderPath = Sheet1.TextBox1.Value 'Infoga backslash i mappvägen om backslash (\) saknas Om Right (FolderPath, 1) "\" Sedan FolderPath = FolderPath & "\" End If 'Söker Excel -filer 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' Skapa en ny arbetsbok Ställ in DestWB = Workbooks.Add För i = 1 Till UBound (FileArray) 'Hitta sista raden i arbetsboken LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Rad' Öppna Excel -arbetsboken Ange källaWB = Workbooks.Open (FolderPath & FileArray (i)) 'Klistra in de kopierade data till sista raden i målarbetsboken Om LastDesRow = 1 Sedan' Kopiera all data i kalkylbladet till sista raden i målarbetsboken Område ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopiera DestWB.ActiveSheet.Cells (LastDesRow, 1) Annat intervall ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopiera DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) Avsluta om SourceWB.Close False Next 'Sparar och stänger en ny Excel -arbetsbok DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Nothing Set SourceWB = Nothing End Sub
Om du gillade den här bloggen, dela den med dina vänner på Facebook. Du kan också följa oss på Twitter och Facebook.
Vi vill gärna höra från dig, låt oss veta hur vi kan förbättra vårt arbete och göra det bättre för dig. Skriv till oss på e -postwebbplatsen