【質問４】

オートフィルタは使わなくてもいいようでしたので。

形式を選択して値を貼付けで、どのような貼り付けをしたのかが抜けているのでその部分はコピーにしています。

指定していただければ変更します。

Sub macro4()
    Dim maxColumn As Integer
    Dim c As Integer
    Dim num As Integer
    Dim r As Long
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    
    maxColumn = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    lastRow2 = Worksheets("Sheet6").Cells(Rows.Count, 13).End(xlUp).Row
    With Worksheets("Sheet4")
    For c = 2 To maxColumn
        num = .Cells(3, c).Value
        lastRow1 = .Cells(Rows.Count, c).End(xlUp).Row + 1
        For r = 1 To lastRow2
            If Worksheets("Sheet6").Cells(r, 13).Value = num Then
                Worksheets("Sheet6").Cells(r, 13).Copy .Cells(lastRow1, c)
                lastRow1 = lastRow1 + 1
            End If
        Next r
    Next
    End With
End Sub

先に続けて、Q1からQ4の処理です。

Sub pinkoQs()
'// Q1 の処理
    Dim Path As String, WSH As Variant
    Set WSH = CreateObject("WScript.Shell")
    
    Path = WSH.SpecialFolders("MyDocuments") & "\cccc\aaaa.xls"
    Dim dstWB As Workbook
    Set dstWB = Workbooks.Open(Path)
'---- 開いているファイルを指定する場合はこっちを使用
'   Set dstWB = Workbooks("aaaa.xls")
    
    Path = WSH.SpecialFolders("MyDocuments") & "\cccc\bbbb.csv"
    Dim srcWB As Workbook
    Set srcWB = Workbooks.Open(Path)
        
    Dim lastRow As Long
    lastRow = srcWB.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row

    srcWB.Worksheets(1).Range("A2").Resize(21, lastRow - 1).Copy _
        Destination:=dstWB.Worksheets("Sheet1").Range("A2").Resize(21, lastRow - 1)
    srcWB.Close

'// Q2 の処理
    dstWB.Worksheets("Sheet2").Activate
    Dim r As Long
    For r = 3 To lastRow - 1
        dstWB.Worksheets("Sheet2").Range("A3:M3").Copy _
            Destination:=dstWB.Worksheets("Sheet2").Range("A1").Offset(r, 0).Resize(1, 13)
    Next

    dstWB.Worksheets("Sheet3").Activate
    For r = 3 To lastRow - 1
        dstWB.Worksheets("Sheet3").Range("A3:L3").Copy _
            Destination:=dstWB.Worksheets("Sheet3").Range("A1").Offset(r, 0).Resize(1, 12)
    Next

'// Q3 の処理
    With dstWB.Worksheets("Sheet4")
        .Activate
        Dim lastCol As Long
        lastCol = lastRow
        For c = 2 To lastCol
            lastRow = .Cells(Rows.Count, c).End(xlUp).Row + 1
            Select Case .Cells(2, c).Value
            Case 2
                Debug.Print .Cells(Rows.Count, c).End(xlUp).Address
                dstWB.Worksheets("Sheet5").Range("A10:A20").Copy _
                    Destination:=.Cells(Rows.Count, c).End(xlUp).Offset(1, 0)
            Case 3
                dstWB.Worksheets("Sheet5").Range("B10:B21").Copy _
                    Destination:=.Cells(Rows.Count, c).End(xlUp).Offset(1, 0)
            Case 4
                dstWB.Worksheets("Sheet5").Range("C10:C25").Copy _
                    Destination:=.Cells(Rows.Count, c).End(xlUp).Offset(1, 0)
            End Select
        Next
    End With

'// Q4 の処理
    Dim srcWS As Worksheet
    Set srcWS = dstWB.Worksheets("Sheet6")
    srcWS.Activate
    
    With dstWB.Worksheets("Sheet4")
        For c = 2 To lastCol
            srcWS.Rows(13).AutoFilter field:=13, Criteria1:="=" & .Cells(3, c).Value
            srcWS.Range("M1").Offset(1, 0).Select
            srcWS.Range(Selection, Selection.End(xlDown)).Copy _
                Destination:=.Cells(Rows.Count, c).End(xlUp).Offset(1, 0)
            srcWS.Rows(13).AutoFilter field:=13
        Next
    End With
End Sub