Microsoft ExcelでVBAを使用して、フォルダ内のすべてのブックにセルをコピー
この記事では、フォルダー内のすべてのブックにセルをコピーするマクロを作成します。
いくつかのサンプルExcelファイルを生データとして使用しました。これらのファイルには、従業員の出席の詳細が含まれています。各ファイルには、日付、従業員ID、および従業員の名前が含まれています。フォルダ内のすべてのファイルにヘッダーを追加します。
マクロを実行すると、H8からJ10の範囲のデータが、フォルダー内のすべてのExcelシートにヘッダーとして貼り付けられます。
コードの説明
FolderPath = Sheet1.TextBox1.Value上記のコードは、変数に言及するためにテキストボックスに値を割り当てるために使用されます。
Dir(FolderPath& “* .xlsx”)
上記のコードは、指定されたフォルダーパス内の最初のファイルのファイル名を取得するために使用されます。
FileName <> “”
Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1)
FileArray(Count1)= FileName FileName = Dir()
Wend上記のコードは、文字列配列を作成するために使用されます。フォルダ内のすべてのファイルのファイル名が含まれています。
Workbooks.Open(FolderPath&FileArray(i))
上記のコードは、指定されたブックを開くために使用されます。
SourceWB.Worksheets(1).Range( “H8:J10″)。Copy DestWB.Worksheets(1).Range( “A1:C3″)
上記のコードは、メインワークブックから他のワークブックにヘッダーをコピーするために使用されます。
コードについては以下に従ってください
Option Explicit Sub CopyingDataToFilesInFolder() 'Declaring variables Dim FileName, FolderPath, FileArray() As String Dim Count1, i As Integer Dim SourceWB, DestWB As Workbook 'Getting folder path from the text box FolderPath = Sheet1.TextBox1.Value If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\" End If 'Getting the file name from the folder FileName = Dir(FolderPath & "*.xlsx") Count1 = 0 'Creating an array which consists of file name of all files in the folder While FileName <> "" Count1 = Count1 + 1 ReDim Preserve FileArray(1 To Count1) FileArray(Count1) = FileName FileName = Dir() Wend Set SourceWB = ThisWorkbook For i = 1 To UBound(FileArray) 'Opening the workbook Set DestWB = Workbooks.Open(FolderPath & FileArray(i)) 'Pasting the required header SourceWB.Worksheets(1).Range("H8:J10").Copy DestWB.Worksheets(1).Range("A1:C3") 'Closing the workbook DestWB.Close True Next Set DestWB = Nothing Set SourceWB = Nothing End Sub
このブログが気に入ったら、FacebookやFacebookで友達と共有してください。
皆様からのご意見をお待ちしております。私たちの仕事を改善し、あなたのために改善する方法をお知らせください。 [email protected]までご連絡ください