I denne artikkelen vil vi lage en makro for å kopiere data fra flere arbeidsbøker i en mappe til en ny arbeidsbok.
Vi skal lage to makroer; én makro vil bare kopiere poster fra første kolonne til den nye arbeidsboken, og den andre makroen vil kopiere alle dataene inn i den.
Rådata for dette eksemplet består av oppmøtejournaler for ansatte. I TestFolder har vi flere Excel -filer. Filnavn på Excel -filer representerer en bestemt dato i "ddmmyyyy" -format.
Hver Excel -fil inneholder dato, ansatt -ID og ansattnavn på de ansatte som var til stede den aktuelle dagen.
Vi har laget to makroer; "CopyingSingleColumnData" og "CopyingMultipleColumnData". Makroen “CopyingSingleColumnData” kopierer bare poster fra den første kolonnen av alle filene i mappen til den nye arbeidsboken. Makroen "CopyingMultipleColumnData" kopierer alle dataene fra alle filene i mappen til den nye arbeidsboken.
Makroen "CopyingSingleColumnData" kan utføres ved å klikke "Kopier enkelt kolonne" -knappen. Makroen "CopyingMultipleColumnData" kan utføres ved å klikke "Kopier flere kolonner" -knappen.
Før du kjører makroen, må du angi banen til mappen i tekstboksen, der Excel -filer plasseres.
Når du klikker på knappen "Kopiering av én kolonne", vil en ny arbeidsbok "ConsolidatedFile" bli generert i den definerte mappen. Denne arbeidsboken vil inneholde konsoliderte data fra første kolonne i alle filene i mappen.
Den nye arbeidsboken vil bare inneholde poster i den første kolonnen. Når vi har de konsoliderte dataene, kan vi finne ut antall ansatte tilstede på en bestemt dag ved å telle antall dato. Antall av en bestemt dato vil være lik antall ansatte som er tilstede den aktuelle dagen.
Når du klikker på knappen "Kopiering av flere kolonner", genererer den den nye arbeidsboken "ConsolidatedAllColumns" i den definerte mappen. Denne arbeidsboken inneholder konsoliderte data fra alle poster i alle filene i mappen.
Den nye arbeidsboken som er opprettet, inneholder alle poster fra alle filene i mappen. Når vi har de konsoliderte dataene, har vi alle oppmøteinformasjonene tilgjengelige i en enkelt fil. Vi kan enkelt finne antall ansatte til stede den aktuelle dagen og også få navn på de ansatte som var til stede den aktuelle dagen.
Kode forklaring
Sheet1.TextBox1.Value
Koden ovenfor brukes for å få verdien satt inn i tekstboksen "TextBox1" fra arket "Sheet1".
Dir (FolderPath og "*.xlsx")
Koden ovenfor brukes til å få navnet på filen, som har filtypen ".xlsx". Vi har brukt jokertegn * for filnavn med flere tegn.
Mens filnavn ""
Count1 = Count1 + 1
ReDim Preserve FileArray (1 å telle1)
FileArray (Count1) = Filnavn
Filnavn = Dir ()
Wend
Koden ovenfor brukes til å få filnavn på alle filene i mappen.
For i = 1 Til UBound (FileArray)
Neste
Koden ovenfor brukes til å gå gjennom alle filene i mappen.
Område ("A1", celler (LastRow, 1)). Kopier DestWB.ActiveSheet.Cells (LastDesRow, 1)
Koden ovenfor brukes til å kopiere posten fra den første kolonnen til arbeidsboken for destinasjonen.
Område ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopier DestWB.ActiveSheet.Cells (LastDesRow, 1)
Koden ovenfor brukes til å kopiere all posten fra den aktive arbeidsboken til arbeidsboken for destinasjonen.
Følg koden nedenfor
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.TextBox Sette inn backslash i mappebanen hvis backslash (\) mangler Hvis Right (FolderPath, 1) "\" Then FolderPath = FolderPath & "\" End If 'Searching for Excel files FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Looping through all Excel files in the folder While FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Opprette en ny arbeidsbok Sett DestWB = Workbooks.Add For i = 1 To UBound (FileArray) 'Finne den siste raden i arbeidsboken LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Row' Åpne Excel -arbeidsbok Angi kildeWB = Workbooks.Open (FolderPath & FileArray (i)) LastRow = ActiveCell.SpecialCells (xlCellTypeLas tCell) .Row 'Limer inn de kopierte dataene til siste rad i arbeidsboka for mål Hvis LastDesRow = 1 Deretter' Kopierer den første kolonnen til siste rad i målearbeidsboken ("A1", Celler (LastRow, 1)). Kopier DestWB. ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", Cells (LastRow, 1)). Kopier DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) Slutt hvis SourceWB.Close False Next 'Lagring og lukking av et 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 'Sett inn backslash i mappebanen hvis tilbakeslag (\) mangler Hvis Right (FolderPath, 1) "\" Deretter FolderPath = FolderPath & "\" End If 'Searching for Excel files FileName = Dir (FolderPath & "*.xlsx") Count1 = 0 'Sløyfe gjennom alle Excel -filene i mappen Mens FileName "" Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1) FileArray (Count1) = FileName FileName = Dir () Wend' Opprette en ny arbeidsbok Sett DestWB = Workbooks.Add For i = 1 Til UBound (FileArray) 'Finne den siste raden i arbeidsboken LastDesRow = DestWB.ActiveSheet.Range ("A1"). SpecialCells (xlCellTypeLastCell) .Rad' Åpne Excel -arbeidsbok Sett kildeWB = Workbooks.Open (FolderPath & FileArray (i)) 'Lim inn de kopierte dataene til den siste raden i arbeidsboka for mål Hvis LastDesRow = 1 Deretter' Kopierer alle dataene i regnearket til siste rad i målearbeidsområdet ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopier DestWB.ActiveSheet.Cells (LastDesRow, 1) Else Range ("A1", ActiveCell.SpecialCells (xlCellTypeLastCell)). Kopier DestWB.ActiveSheet.Cells (LastDesRow + 1, 1) End If SourceWB.Close False Next 'Lagring og lukking en ny Excel -arbeidsbok DestWB.SaveAs FileName: = FolderPath & "ConsolidatedAllColumns.xlsx" DestWB.Close Set D estWB = Nothing Set SourceWB = Nothing End Sub
Hvis du likte denne bloggen, del den med vennene dine på Facebook. Du kan også følge oss på Twitter og Facebook.
Vi vil gjerne høre fra deg, gi oss beskjed om hvordan vi kan forbedre arbeidet vårt og gjøre det bedre for deg. Skriv til oss på e -post