VBA復制具有特定值的行和列標題

Question

我是Visual Basic的新手，我有以下格式的Excel工作表，如下圖所示。

我需要編寫一個VB代碼來創建電子表格，格式如下圖所示。 應當在excel工作表中為行和列值為“ 1”的每個國家/地區打印型號名稱。 換句話說，只需在電子表格中打印型號名稱和國家/地區名稱，其值為“ 1”。 如果單元格為空或值為“ 0”，則我們無需為該特定國家/地區打印型號名稱。

我該怎么辦？ 我一直在看視頻來做到這一點，但無濟於事。

誰能告訴我該怎么做？ 任何形式的幫助將不勝感激。 提前致謝。

編輯：使用以下代碼后的當前輸出在此屏幕截圖中

Answer 1

這應該可以順利進行，它將在每次運行時創建一個新工作表以顯示輸出！ ;）

Sub test_Dazzler()

Dim wB As Workbook, _
    wBNeW As Workbook, _
    wSSrC As Worksheet, _
    wSDesT As Worksheet, _
    LastRow As Long, _
    LastCol As Integer, _
    WrintingRow As Long, _
    ModeL As String

Set wB = ThisWorkbook
Set wSSrC = wB.ActiveSheet
LastRow = wSSrC.Range("A" & wSSrC.Rows.Count).End(xlUp).Row
LastCol = wSSrC.Range("A1").End(xlToRight).Column
Set wSDesT = wB.Sheets.Add
wSDesT.Cells(1, 1) = "Model": wSDesT.Cells(1, 2) = "Countries"

With wSSrC
    For i = 2 To LastRow
        ModeL = .Range("A" & i).Value
        For j = 2 To LastCol
            If .Cells(i, j) <> 1 Then
            Else
                WrintingRow = wSDesT.Range("A" & wSDesT.Rows.Count).End(xlUp).Row + 1
                wSDesT.Cells(WrintingRow, 1) = ModeL
                wSDesT.Cells(WrintingRow, 2) = .Cells(1, j)
            End If
        Next j
    Next i
    DoEvents
    WsDest.Copy
End With
Set wBNeW = ActiveWorkbook

Dim intChoice As Integer
Dim strPath As String

'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogSaveAs).Show
'determine what choice the user made
If intChoice <> 0 Then
    'get the file path selected by the user
    strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
    If strPath <> False Then wBNeW.SaveAs strPath
    'displays the result in a message box
    Call MsgBox(strPath, vbInformation, "Save Path")
End If

MsgBox "I'm done!"
End Sub