Excel2007 VBA复制整行到其它sheet

Posted 2023-04-23

我要把A列中的数据逐行检查是否是空的，如果是空的就存到sheet4(从第二行开始保存),如果是不空就把内容存到sheet5，(也从第二行开始保存),看下我的这句写的对吗，要是对，问号处如何补完整，谢谢

Dim i As Integer
For i = 1 To 1000
If Cells(i, 1).Value = "" Then　　
??????????????
Else
??????????????

1、进入EXCEL,ALT+F11进入VBA编辑器。

3、在工作表中插入表单控件，并指定到宏Macro1。

3、在工作表中插入表单控件，并指定到宏Macro1。

4、点击表单控件，语言中的整行整列就被选中了。

参考技术A '这是不带单元格格式的
Dim i As Integer
For i = 1 To 1000
   If Cells(i, 1).Value = "" Then　　
      N4=N4+1
      sheet4.rows(n4+1).value=rows(i).value
   Else
      N5=N5+1
      sheet5.rows(n5+1).value=rows(i).value
   end if
next

'这是带格式一起复制的
Dim i As Integer
For i = 1 To 1000
   If Cells(i, 1).Value = "" Then　　
      N4=N4+1
      rows(i).copy sheet4.rows(n4+1)
   Else
      N5=N5+1
      rows(i).copy sheet5.rows(n5+1)
   end if
next

参考技术B Dim i As Integer,j4,j5
j4=2
j5=2
For i = 1 To 1000
   If Cells(i, 1).Value = "" Then　　
      rows(i).copy sheet4.rows(j4)
      j4=j4+1
   Else
      rows(i).copy sheet5.rows(j5)
       j5=j5+1

本回答被提问者采纳 参考技术C 为空你保存什么？追问

整行啊，如果是空的就把整行拷到sheet5,别的格里有内容，谢谢

追答学习用数组练练手
Sub 空值拆分()
   Dim Arr, Brr, Crr, I, J, k, m
   Arr = Sheets(1).UsedRange
    On Error GoTo 100
    For n = 1 To 61
    h = UBound(Arr, n)
    Next
100
   ReDim Brr(1 To UBound(Arr), 1 To h)
   ReDim Crr(1 To UBound(Arr), 1 To h)
        k = 1
        m = 1
    For I = 1 To UBound(Arr)
      If Arr(I, 1) = "" Then
            For J = 1 To h
               Brr(k, J) = Arr(I, J)
            Next J
        k = k + 1
        Else
         For J = 1 To h
            Crr(m, J) = Arr(I, J)
          Next J
          m = m + 1
      End If
      Next I
    Worksheets("sheet4").Range("a2").Resize(k, h) = Brr
    Worksheets("sheet5").Range("a2").Resize(m, h) = Crr
 End Sub

使用 Excel VBA 实现复制 粘贴 和保存，并自动运行VBA

请高手帮忙编写一段VBA代码
可以执行以下命令：
在Sheet1里只要按回车键就自动执行复制Sheet1的第4行到500行的所有内容，粘贴到Sheet 2的第4行到500行，并保存。

代码如下，注意代码的位置（详见截图）

Private Sub Worksheet_Activate()
   Application.OnKey "~", "Copy4To500"
   'Application.OnKey "ENTER", "Copy4To500" '小键盘回车键
End Sub
Private Sub Worksheet_Deactivate()
   Application.OnKey "~"
   'Application.OnKey "ENTER"
End Sub
Sub Copy4To500()
   Rows("4:500").Copy Sheet2.Range("A4")
   ThisWorkbook.Save
End Sub

参考技术A 这个超级简单。录制一个宏
按照你需要的操作一步一步的来。然后保存，最后再指定一个快捷键
搞点。 参考技术B

可使用VBA事件。    

A. 将如下代码复制粘贴在sheet1代码中。    

B.回车运行即可。    

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.DisplayAlerts = False

On Error Resume Next

Worksheets(1).Rows("4:500").Copy Worksheets(2).Range("4:500")

ActiveWorkbook.Save

Application.DisplayAlerts = True

End Sub

参考技术C 代码复制到sheet1
Sub 复制()
Rows("4:500").Copy Sheets(2).[A4]
Sheets(2).Select
MsgBox "复制完成....."
End Sub
自己指定一个 快捷键即可 参考技术D 用回车键激活，这个有点夸张了。。可以试试用其它键录制宏。回车键即使实现了也会出现很多不比较的麻烦