Excel macro - paste only non empty cells from one sheet to another

断了今生、忘了曾经 提交于 2019-12-17 06:49:10

问题


Below is the code which I am using to copy cells from one sheet and paste in to another.

Sheets("codes").Select
Range("A5:A100").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B28").Select
ActiveSheet.Paste

The problem with this is some cells in this range are blank but I do not want them to be copied to Sheet2. I have got some idea from here but this method is too long. Is there a way I can iterate on the selection and check if the value is non-empty and paste. This way I can also paste some other text (eg #NA) in the blank cells.


回答1:


Looks like you may be making some common rookie mistakes here (it's okay we all did it).


VBA example with line-by-line explanations

TIP: Try not to use "Select" or "Copy". Why use select when all you have to do is reference the cells themselves? For example, instead of using

Sheets("codes").Select
Range("A5:A100").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B28").Select
ActiveSheet.Paste

Just use

dim mySheet as Worksheet, myOtherSheet as Worksheet, myBook as Workbook 'Define your workbooks and worksheets as variables
set myBook = Excel.ActiveWorkbook
set mySheet = myBook.Sheets("codes")
set myOtherSheet = myBook.Sheets("Sheet2")

dim i as integer, j as integer 'Define a couple integer variables for counting

j = 28 'This variable will keep track of which row we're on in Sheet2 (I'm assuming you want to start on line 28)
for i = 5 to 100 'This is the beginning the the loop which will repeat from 5 to 100 . . .
   if mySheet.Cells(i,1).value <> "" then ' . . . for each digit, it will check if the cell's value is blank. If it isn't then it will . . .
      myOtherSheet.Cells(j,2).value = mySheet.Cells(i,1).value ' . . . Copy that value into the cell on Sheet2 in the row specified by our "j" variable.
      j = j + 1 'Then we add one to the "j" variable so the next time it copies, we will be on the next available row in Sheet2.
   end if
next i 'This triggers the end of the loop and moves on to the next value of "i".

I did the same thing all the time when I first started, and it never works out right. "Select" causes errors left and right. Use my code, read the comments, and you'll be fine. A quick WARNING: I don't have Excel on this computer so I couldn't test the code. If it doesn't work for some reason, leave me a comment and tomorrow I'll fix it at work.

The above code will omit blank cells completely when copying the data over to your second sheet. If you want to input a certain text for blank cells instead (like "N/A"), then you can use the following:

 dim mySheet as Worksheet, myOtherSheet as Worksheet, myBook as Workbook 'Define your workbooks and worksheets as variables
 set myBook = Excel.ActiveWorkbook
 set mySheet = myBook.Sheets("codes")
 set myOtherSheet = myBook.Sheets("Sheet2")

 dim i as integer, j as integer 'Define a couple integer variables for counting

 j = 28 'This variable will keep track of which row we're on in Sheet2 (I'm assuming you want to start on line 28)
 for i = 5 to 100 'This is the beginning the the loop which will repeat from 5 to 100 . . .
    if mySheet.Cells(i,1).value <> "" then ' . . . for each digit, it will check if the cell's value is blank. If it isn't then it will . . .
       myOtherSheet.Cells(j,2).value = mySheet.Cells(i,1).value ' . . . Copy that value into the cell on Sheet2 in the row specified by our "j" variable.
    else 'If the cell is blank, then . . .
       myOtherSheet.Cells(j,2).value = "N/A" ' . . . place the text "N/A" into the cell in row "j" in Sheet2.
    end if 'NOTICE we moved the "end if" statement up a line, so that it closes the "if" statement before the "j = j + 1" statement. _
      This is because now we want to add one to the "j" variable (i.e., move to the next available row in Sheet2) regardless of whether the cell in the "codes" sheet is blank or not.
       j = j + 1 'Then we add one to the "j" variable so the next time it copies, we will be on the next available row in Sheet2.
 next i 'This triggers the end of the loop and moves on to the next value of "i".



回答2:


Easy:

  Sheet1.Range("A1:a500").SpecialCells(xlCellTypeConstants).Copy Sheet2.Range("b2")

I used xlCellTypeConstants but there are many other possibilities.

Sheet1 is generally equivalent to Sheets("Sheet1"). The first one is the name in the VBE (programmer view), the second is the name in the user interface (user view). I generally prefer the fiirst syntax because it is shorter and allows renaming the sheets (for the user) without impacting the code.




回答3:


If you don't need formatting I'd use the following. All it does is copy the range you specify on the worksheet to a variable, loop through that variable, check for cells that are empty and put in whatever string you like. It's nice and quick. If you want to preserve the formatting, you can paste special just the formats to the output range.

Sub CopyNonBlankCells(rFromRange As Range, rToCell As Range, sSubIn As String)
    'You have three inputs.  A range to copy from (rFromRange), a range to copy to (rToCell) and a string to put in the blank cells.        

    Dim vData As Variant, ii As Integer, jj As Integer

   'Set to a variable since it's quicker
    vData = rFromRange.Value

    'Loop through to find the blank cells
    For ii = LBound(vData, 1) To UBound(vData, 1)   'Loop the rows
        For jj = LBound(vData, 2) To UBound(vData, 2)    'Loop the columns
            'Check for empty cell.  Quicker to use Len function then check for empty string
            If VBA.Len(vData(ii, jj)) = 0 Then vData(ii, jj) = sSubIn
        Next jj
    Next ii

    'Output to target cell.  Use the 'With' statement because it makes the code easier to read and is more efficient
    With rToCell.Parent
        .Range(.Cells(rToCell.Row, rToCell.Column), .Cells(rToCell.Row + UBound(vData, 1) - 1, rToCell.Column + UBound(vData, 2) - 1)).Value = vData
    End With

End Sub

And call it with:

Call CopyNonBlankCells(Sheets("codes").Range("A5:A100"), Sheets("Sheet2").Range("B28"), "Non-blank")


来源:https://stackoverflow.com/questions/14495769/excel-macro-paste-only-non-empty-cells-from-one-sheet-to-another

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!