誰かが私を助けてくれるのではないかと思います。
以下のコードを使用して、ユーザーが複数のExcelブックからコピーし、データを概要シートにマージできるようにします。
Sub Merge()
Dim DestWB As Workbook, WB As Workbook, WS As Worksheet, SourceSheet As String
Set DestWB = ActiveWorkbook
SourceSheet = "Input"
startrow = 7
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls*),*.xls*", _
Title:="Select the workbooks to merge.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
Exit Sub
End If
End If
For n = LBound(FileNames) To UBound(FileNames)
Set WB = Workbooks.Open(Filename:=FileNames(n), ReadOnly:=True)
For Each WS In WB.Worksheets
If WS.Name = SourceSheet Then
With WS
If .UsedRange.Cells.Count > 1 Then
dr = DestWB.Worksheets("Input").Range("C" & Rows.Count).End(xlUp).Row + 1
lastrow = .Range("C" & Rows.Count).End(xlUp).Row
For j = lastrow To startrow Step -1
If Range("E" & j) <> "Requirements Manager" And Range("E" & j) <> "R & D Lead" And Range("E" & j) <> "Technical" And Range("E" & j) <> "Analyst" Then Rows(j).Delete
Next
lastrow = .Range("C" & Rows.Count).End(xlUp).Row
If lastrow >= startrow Then
.Range("A" & startrow & ":AQ" & lastrow).Copy
DestWB.Worksheets("Input").Cells(dr, "A").PasteSpecial xlValues
End If
End If
End With
Exit For
End If
Next WS
WB.Close savechanges:=False
Next n
End Sub
コードは正常に機能しますが、情報のコピーに関連する問題が発生します。これは次のコード行です。
.Range("A" & startrow & ":AQ" & lastrow).Copy
2つの範囲を考慮に入れるようにこれを変更する必要があります。これらは「B:AD」列と「AF:AQ」列ですが、これを行う方法がわかりません。
誰かがこれを見て、私がこれを解決する方法についていくつかのガイダンスを提供できるかどうか疑問に思いました。
よろしくお願いします