VBA-將特定標題從工作表復制到另一個

Question

我嘗試復制具有以下帶有“強制”值的單元格的標頭，但我的宏停在第一個單元格處。 名稱電話號碼否地點必選

  Dim i As Long, j As Long, Lastrow1 As Long, Lastcol1 As Long
Dim mandatory As String

'Lastrow1 = Sheets("sheet3").Range("A" & Rows.Count).End(xlUp).Row
Lastcol1 = Sheets("sheet3").Cells(1 & Columns.Count).End(xlToLeft).Column
For i = 1 To Lastcol1

Sheets("sheet4").Activate
Lastcol2 = Sheets("sheet4").Cells(1 & Columns.Count).End(xlToLeft).Column
For j = 1 To Lastcol2

If Sheets("sheet3").Cells(2, i).Value = "mandatory" Then
Sheets("sheet3").Activate
Sheets("sheet3").Cells(i, "A").Copy
Sheets("sheet4").Activate
Sheets("sheet4").Cells(j, "A").Select
ActiveSheet.Paste
End If

Next j

Application.CutCopyMode = False
Next i
Sheets("sheet3").Activate
Sheets("sheet3").Range("A1").Select


End Sub

Answer 1

除了上面在注釋中已經說過的內容外，還通過在結尾處查找一個空單元格來將j的列數設置為0。

用這個：

Dim i As Long, j As Long, Lastrow1 As Long, Lastcol1 As Long

Lastcol1 = Sheets("sheet3").Cells(1 , Columns.count).End(xlToLeft).Column
For i = 1 To Lastcol1
    j = Sheets("sheet4").Cells(1 , Columns.count).End(xlToLeft).Offset(, 1).Column
    if j = 2 and Sheets("sheet4").Cells(1,j-1).value ="" then j=1
    If ucase(Sheets("sheet3").Cells(2, i).Value) = "MANDATORY" Then
        Sheets("sheet3").Cells(1, i).Copy Sheets("sheet4").Cells(1,j)
    End If
    Application.CutCopyMode = False
Next i
Sheets("sheet3").Range("A1").Select

而且由於您要逐個單元而不是復制，因此只需使新的單元值等於舊的單元值即可。

Sheets("sheet4").Cells(1,j).value = Sheets("sheet3").Cells(1, i).value