如果不是空白，VBA将单元格内容复制到下一行的单元格

大佬教程收集整理的这篇文章主要介绍了如果不是空白，VBA将单元格内容复制到下一行的单元格，大佬教程大佬觉得挺不错的，现在分享给大家，也给大家做个参考。

如何解决如果不是空白，VBA将单元格内容复制到下一行的单元格？

我在 A 到 H 列有数据。有些行在 H 中有数据。如果 HI 中有数据，需要在下一行之前插入一行并将 H 的内容复制到新行到单元格 F。>

我发现的所有示例代码都希望将数据放在表末尾的下一个打开行中。

如果 H 不为空，我找到了插入一行的代码。

如果不是空白，我需要将 H 复制到下一行并复制到 F 列的单元格中。

到目前为止我所做的：

Sub Setupdata()
    'This copIEs specific cells from PasteDataHere worksheet
    Application.Screenupdating = false

    Dim s1 As Excel.Worksheet
    Dim s2 As Excel.Worksheet
    Dim iLastCellS2 As Excel.Range
    Dim iLastRowS1 As Long

    Set s1 = Sheets("PasteDataHere")
    Set s2 = Sheets("Step1")

    ' get last row of H in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"H").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"A").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("H1",s1.Cells(iLastRowS1,"H")).copy iLastCellS2

    ' get last row of I in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"I").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"B").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("I1","I")).copy iLastCellS2
    
    ' get last row of K in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"K").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"C").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("K1","K")).copy iLastCellS2
    
    ' get last row of M in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"M").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"D").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("M1","M")).copy iLastCellS2
    
    ' get last row of N in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"N").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"E").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("N1","N")).copy iLastCellS2
    
    ' get last row of E in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"E").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"F").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("E1","E")).copy iLastCellS2
    
    ' get last row of G in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"G").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"G").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("G1","G")).copy iLastCellS2
   
    ' get last row of H in PasteDataHere
    iLastRowS1 = s1.Cells(s1.Rows.Count,"S").End(xlUp).Row

    ' get last AVAILABLE cell to past into
    Set iLastCellS2 = s2.Cells(s2.Rows.Count,"H").End(xlUp).offset(0,0)

    'copy into Step1
    s1.Range("S1","S")).copy iLastCellS2

    Application.Screenupdating = True
    
    'this step puts a space below any row that has data in "H"
    Dim rng As Range
    For Each rng In Range("H1:H62555")
        If Not IsEmpty(rng) Then
            rng.offset(1,0).EntireRow.Insert
        End If
    Next

End Sub

解决方法

Option Explicit

Sub Setupdata()

Dim ws1 As Worksheet
Dim Lastws1 As Long,i As Long
Dim Rng As Range
Application.Screenupdating = false

Set ws1 = ThisWorkbook.Worksheets("Sheet1") '<~~ change sheet name to suit

Lastws1 = ws1.Cells(Rows.Count,"H").End(xlUp).Row

Set Rng = Sheet1.Range("H2:H" & Lastws1)

For i = Lastws1 To 1 Step -1
    
    If Rng.Item(i) <> "" Then
            Rng.Item(i).offset(1,0).EntireRow.Insert shift:=xlDown
            Rng.Item(i).offset(1,-2) = Rng.Item(i).Value
    End If

Next i

Application.Screenupdating = True

End Sub

大佬总结

以上是大佬教程为你收集整理的如果不是空白，VBA将单元格内容复制到下一行的单元格全部内容，希望文章能够帮你解决如果不是空白，VBA将单元格内容复制到下一行的单元格所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错，欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ：384754419，请注明来意。