Excel 为非空值复制多个行和列

我正在尝试将一组数据转换为不同的格式进行导出

我只希望复制具有值的行

从D列开始（见附件），我想筛选非空白值，并在新工作表的五列中复制B、C、D、CellD2、CellD3列。然后对D列后面有值的所有列重复相同的操作

数据集可以有多个列（无固定限制）和多个行（无固定限制）

这是我正在处理的数据（表名为“LJM Fert”）

这是我试图实现的最终结果（图纸名称为“导出”）

我写的代码

Sub CopyPaste()

Dim Totalrows As Long
Dim Totalcolumns As Long
Dim rowloop As Long
Dim columnloop As Long
Dim rowcount As Long
Dim columncount As Long
Dim pastestart As Long

    Sheets("LJM Fert").Activate

    Totalrows = ActiveSheet.UsedRange.Rows.Count
    Totalcolumns = ActiveSheet.UsedRange.Columns.Count
    rowcount = 4
    columncount = 4
    pastestart = 2
        
    For rowloop = rowcount To Totalrows
        
        For columnloop = columncount To Totalcolumns
        
            If ActiveSheet.Cells(rowcount, columncount).Value <> "" Then

                ActiveSheet.Cells(rowcount, 2).Copy
                Sheets("Export").Activate
                ActiveSheet.Cells(pastestart, 1).Paste
                Sheets("LJM Fert").Activate
        
                ActiveSheet.Cells(rowcount, 3).Copy
                Sheets("Export").Activate
                ActiveSheet.Cells(pastestart, 2).Paste
                Sheets("LJM Fert").Activate
        
                ActiveSheet.Cells(rowcount, columncount).Copy
                Sheets("Export").Activate
                ActiveSheet.Cells(pastestart, 3).Paste
                Sheets("LJM Fert").Activate
       
                ActiveSheet.Cells(2, columncount).Copy
                Sheets("Export").Activate
                ActiveSheet.Cells(pastestart, 4).Paste
                Sheets("LJM Fert").Activate
        
                ActiveSheet.Cells(3, columncount).Copy
                Sheets("Export").Activate
                ActiveSheet.Cells(pastestart, 5).Paste
                Sheets("LJM Fert").Activate
        
            End If
        
            columncount = columncount + 1
            pastestart = pastestart + 1
        
        Next
    Next
                   
    Application.CutCopyMode = False
    'ThisWorkbook.Worksheets("Export").Cells(1, 1).Select

End Sub

子复制粘贴（）
所有行的长度相同
将所有列的长度设置为
像长的一样暗的圈
暗柱状环与长柱状环相同
暗行数与长行数相同
暗列与长列数相同
我会尽可能长的开始
工作表（“LJM Fert”）。激活
Totalrows=ActiveSheet.UsedRange.Rows.Count
Totalcolumns=ActiveSheet.UsedRange.Columns.Count
行数=4
columncount=4
pastestart=2
For rowloop=行计数到总行数
For columnloop=columncount到Totalcolumns
如果ActiveSheet.Cells（rowcount、columncount）.Value为“”，则
ActiveSheet.Cells（行数，2）。复制
工作表（“导出”）。激活
ActiveSheet.Cells（粘贴开始，1）.粘贴
工作表（“LJM Fert”）。激活
ActiveSheet.Cells（行数，3）。复制
工作表（“导出”）。激活
ActiveSheet.Cells（粘贴开始，2）.粘贴
工作表（“LJM Fert”）。激活
ActiveSheet.Cells（行数、列数）。复制
工作表（“导出”）。激活
ActiveSheet.Cells（粘贴开始，3）.粘贴
工作表（“LJM Fert”）。激活
ActiveSheet.Cells（2，columncount）.复制
工作表（“导出”）。激活
ActiveSheet.Cells（粘贴开始，4）.粘贴
工作表（“LJM Fert”）。激活
ActiveSheet.Cells（3，columncount）.复制
工作表（“导出”）。激活
单元格（粘贴开始，5）。粘贴
工作表（“LJM Fert”）。激活
如果结束
columncount=columncount+1
粘贴开始=粘贴开始+1
下一个
下一个
Application.CutCopyMode=False
'此工作簿。工作表（“导出”）。单元格（1，1）。选择
端接头

您可以这样做：

'Define Variables
Dim shtExport As Worksheet, shtFert As Worksheet
Dim i As Integer
Dim cell as Range

'Assign Variables
Set shtExport = Sheets("Export")
Set shtFert = Sheets("LJM Fert")

i = 1 'first line where to copy data in Sheet "Export"

For Each cell In shtFert.Range("D4:G20") 'Go through each cell in table

    If cell.Value <> 0 Then

        shtExport.Cells(i, 1) = shtFert.Cells(cell.Row, 2) 'Column A
        shtExport.Cells(i, 2) = shtFert.Cells(cell.Row, 3) 'Column B
        shtExport.Cells(i, 3) = shtFert.Cells(cell.Row, cell.Column) 'Column C
        shtExport.Cells(i, 4) = shtFert.Cells(2, cell.Column) 'Column D
        shtExport.Cells(i, 5) = shtFert.Cells(3, cell.Column) 'Column E

    i = i + 1 'use next row in sheet Export

    End If

Next

定义变量 Dim shtExport作为工作表，shtFert作为工作表 作为整数的Dim i 暗淡单元格作为范围 '分配变量 设置shtExport=图纸（“导出”） 设置shtFert=图纸（“LJM Fert”） i=1'在“导出”表中复制数据的第一行 对于shtFert.Range（“D4:G20”）中的每个单元格，遍历表中的每个单元格 如果单元格.Value为0，则 shtExport.Cells（i，1）=shtFert.Cells（cell.Row，2）”列A shtExport.Cells（i，2）=shtFert.Cells（cell.Row，3）”列B shtExport.Cells（i，3）=shtFert.Cells（cell.Row，cell.Column）'C列 shtExport.Cells（i，4）=shtFert.Cells（2，cell.Column）'D列 shtExport.Cells（i，5）=shtFert.Cells（3，cell.Column）'E列 i=i+1'使用图纸导出中的下一行 如果结束 下一个 这基本上是通过表格“LJM Fert”中D4:G20范围内的每个单元格，检查此单元格是否与0不同，如果是：它将在导出表格中“复制”此单元格。对于每个不同于0的单元格，依此类推

---

在任何情况下，请确保您不使用复制/粘贴，与我上面写的相比，它的速度非常慢。最好是将范围或单元格设置为彼此相等

您可以这样做：

'Define Variables
Dim shtExport As Worksheet, shtFert As Worksheet
Dim i As Integer
Dim cell as Range

'Assign Variables
Set shtExport = Sheets("Export")
Set shtFert = Sheets("LJM Fert")

i = 1 'first line where to copy data in Sheet "Export"

For Each cell In shtFert.Range("D4:G20") 'Go through each cell in table

    If cell.Value <> 0 Then

        shtExport.Cells(i, 1) = shtFert.Cells(cell.Row, 2) 'Column A
        shtExport.Cells(i, 2) = shtFert.Cells(cell.Row, 3) 'Column B
        shtExport.Cells(i, 3) = shtFert.Cells(cell.Row, cell.Column) 'Column C
        shtExport.Cells(i, 4) = shtFert.Cells(2, cell.Column) 'Column D
        shtExport.Cells(i, 5) = shtFert.Cells(3, cell.Column) 'Column E

    i = i + 1 'use next row in sheet Export

    End If

Next

定义变量 Dim shtExport作为工作表，shtFert作为工作表 作为整数的Dim i 暗淡单元格作为范围 '分配变量 设置shtExport=图纸（“导出”） 设置shtFert=图纸（“LJM Fert”） i=1'在“导出”表中复制数据的第一行 对于shtFert.Range（“D4:G20”）中的每个单元格，遍历表中的每个单元格 如果单元格.Value为0，则 shtExport.Cells（i，1）=shtFert.Cells（cell.Row，2）”列A shtExport.Cells（i，2）=shtFert.Cells（cell.Row，3）”列B shtExport.Cells（i，3）=shtFert.Cells（cell.Row，cell.Column）'C列 shtExport.Cells（i，4）=shtFert.Cells（2，cell.Column）'D列 shtExport.Cells（i，5）=shtFert.Cells（3，cell.Column）'E列 i=i+1'使用图纸导出中的下一行 如果结束 下一个 这基本上是通过表格“LJM Fert”中D4:G20范围内的每个单元格，检查此单元格是否与0不同，如果是：它将在导出表格中“复制”此单元格。对于每个不同于0的单元格，依此类推

---

在任何情况下，请确保您不使用复制/粘贴，与我上面写的相比，它的速度非常慢。最好是将范围或单元格设置为彼此相等

非常感谢！！你太棒了：）@Jess不客气！你能把答案标为已接受吗？我是新来的，所以这对我也有帮助！谢谢！！你太棒了：）@Jess不客气！你能把答案标为已接受吗？我是新来的，所以这对我也有帮助！