Kopier et ark fra hver arbeidsbok til arbeidsboken din i en mappe ved hjelp av VBA i Microsoft Excel

Anonim
  • Makroen kopierer en del av det første regnearket i hver fil i mappen C: \ Data til det første regnearket i arbeidsboken.
  • Den første makroen gjør en normal kopi og den andre makro kopierer verdiene.

Det vil kopiere det første arket i hver arbeidsbok til arbeidsboken der koden er.
Arknavnet er navnet på arbeidsboken.

Sub CopySheet () Dim basebook As Workbook Dim mybook As Workbook Dim i As Long Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "C: \ Data" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute ()> 0 Sett deretter basebook = ThisWorkbook For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open (.FoundFiles (i)) mybook.Worksheets (1) .Copy after: = _ basebook.Sheets (basebook.Sheets.Count) ActiveSheet.Name = mybook.Name mybook.Close Next i End If End with Application.ScreenUpdating = True End Sub

For denne delen (TestFile4_values) må du ha ubeskyttede regneark, eller fjerne beskyttelsen av dem i koden.

Sub CopySheetValues ​​() Dim basebook As Workbook Dim mybook As Workbook Dim i As Long Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "C: \ Data" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute (>) 0 Sett deretter basebook = ThisWorkbook For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open (.FoundFiles (i)) mybook.Worksheets (1) .Copy after: = _ basebook.Sheets (basebook.Sheets.Count) ActiveSheet.Name = mybook.Name With ActiveSheet.UsedRange .Value = .Value End With mybook.Close Next i End If End With Application.ScreenUpdating = True End Sub