copy empty cell in excel

Question

I have an Excel file with 3 worksheets.
From the first worksheet called 'Main', I want to copy entire lines to the second worksheet called 'INS' if the cell in column 'I' is empty and I want to copy entire lines to the third worksheet called 'SEC' if the cell in column H is empty. Google Sheets Sample of My Workbook

loop each row of the specialcells blank cells range, returning J2 and H4 for example, .row will return 2 then 4 — Nathan_Sav

VBasic2008 VBasic2008 · Accepted Answer · 2018-12-11T13:58:01

Copy Rows to Different Sheets

Carefully adjust the data in the constants section to fit your needs.

Option Explicit

Sub CopyData()

  ' Constants
  Const cVntSource As String = "Main"    ' Source Worksheet Name or Index
  Const cLngFirstRow As Long = 2         ' Source First Row of Data Number
  Const cVntTarget1 As String = "INS"    ' Target1 Worksheet Name or Index
  Const cVntTarget2 As String = "SEC"    ' Target2 Worksheet Name or Index
  Const cVntCol1 As Variant = "I"        ' Column Letter or Number for Target1
  Const cVntCol2 As Variant = "H"        ' Column Letter or Number for Target2

  ' Object Variables
  Dim objSource As Worksheet             ' Source Worksheet (object)
  Dim objT1 As Worksheet                 ' Target1 Worksheet (object)
  Dim objT2 As Worksheet                 ' Target2 Worksheet (object)

  ' Other Variables
  Dim lngLastRow As Long                 ' Source Last Row of Data Number
  Dim lngSource As Long                  ' Source Rows Counter
  Dim lngT1 As Long                      ' Target1 Rows Counter
  Dim lngT2 As Long                      ' Target2 Rows Counter

  ' Create object references.
  With ThisWorkbook
    Set objSource = .Worksheets(cVntSource)
    Set objT1 = .Worksheets(cVntTarget1)
    Set objT2 = .Worksheets(cVntTarget2)
  End With

  With objSource

    ' Calculate last row of data in Source Worksheet
    lngLastRow = .UsedRange.Rows.Count + .UsedRange.Row - 1

    ' Calculate first free row in Target Worksheets.
    ' If any of sheets are empty, code will paste starting from row 2.
    lngT1 = objT1.UsedRange.Rows.Count + objT1.UsedRange.Row - 1
    lngT2 = objT2.UsedRange.Rows.Count + objT2.UsedRange.Row - 1

    ' Loop through the cells of Source Worksheet from first to last row of data.
    For lngSource = cLngFirstRow To lngLastRow

      ' Check condition for Target1 Worksheet: Empty cell in column CVntCol1.
      If .Cells(lngSource, cVntCol1) = "" Then ' Cell is empty.
        lngT1 = lngT1 + 1
        .Cells(lngSource, cVntCol1).EntireRow.Copy _
        objT1.Cells(lngT1, 1).EntireRow
'       Else ' Cell is not empty.
      End If

      ' Check condition for Target2 Worksheet: Empty cell in column CVntCol2.
      If .Cells(lngSource, cVntCol2) = "" Then ' Cell is empty.
        lngT2 = lngT2 + 1
        .Cells(lngSource, cVntCol2).EntireRow.Copy _
        objT2.Cells(lngT2, 1).EntireRow
'       Else ' Cell is not empty.
      End If

    Next

  End With

  ' Release object references.
  Set objT2 = Nothing
  Set objT1 = Nothing
  Set objSource = Nothing

End Sub

copy empty cell in excel

1 Answers

Copy Rows to Different Sheets