VBA复制具有特定值的行和列标题

我对Visual Basic很新，我有一个如下图所示的Excel格式的表格。

我需要编写一个VB代码来创build一个电子表格，格式如下图所示。 应该在Excel表格中为每个具有行和列值为“1”的国家打印模型名称。 换句话说，只需要在电子表格中打印具有值“1”的模型名称和国家/地区名称即可。 如果单元格为空或值为'0'，那么我们不需要打印该特定国家的型号名称。

我如何去做呢？ 我一直在看video做这个，但无济于事。

任何人都可以请告诉我如何做到这一点？ 任何forms的帮助将不胜感激。 提前致谢。

编辑：使用下面的代码后的当前输出是在这个截图

Answer 1

这应该工作顺利，它会创build一个新的工作表在每一次运行显示输出！ ;）

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