この記事では、フォルダー内のすべてのブックにセルをコピーするマクロを作成します。

いくつかのサンプルExcelファイルを生データとして使用しました。これらのファイルには、従業員の出席の詳細が含まれています。各ファイルには、日付、従業員ID、および従業員の名前が含まれています。フォルダ内のすべてのファイルにヘッダーを追加します。

ArrowMain

ArrowFilesInFolder

ArrowRawData

マクロを実行すると、H8からJ10の範囲のデータが、フォルダー内のすべてのExcelシートにヘッダーとして貼り付けられます。

ArrowOutput

コードの説明

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]までご連絡ください