Copy row and delete rows

[le888]

Hi,

I have written a code that copy the first row in sheet1 to sheet4 and then, delete the first row from the sheet1 to sheet3. However this don't work. Please see code.

Thanks,

  For Each Cell In [A1:F1]

    Cell.Select
    Selection.Copy
    Worksheets(4).Paste
    ActiveWorkbook.Sheets(1, 3).DeleteRows [A1:IV1]
 
  Next Cell

 

[shades]

Hi,

I have written a code that copy the first row in sheet1 to sheet4 and then, delete the first row from the sheet1 to sheet3. However this don't work. Please see code.

Thanks,

  For Each Cell In [A1:F1]

    Cell.Select
    Selection.Copy
    Worksheets(4).Paste
    ActiveWorkbook.Sheets(1, 3).DeleteRows [A1:IV1]
 
  Next Cell

Howdy. I assume you mean the part that doesn't work is the last line trying to delete it. You have to set up a loop to work through each worksheet.

Dim lngWS as Long
For lngWS = 1 to 3
    Sheets(lngWS).Rows("1:1").Delete Shift:=xlUp
Next lngWS

________
Turbo

 

[le888]

Thanks, it doesn't copy the whole row, it copy one cell only which is F1.

Thanks,

Le

 

[shades]

Do you want each cell in A1:F1 to be copied? Or the entire row? Is each cell being copied to a different worksheet?

Guess I'm not clear on what you are trying to achieve. I'm probably just being old.
________
Easy Vape

 

[shades]

Try this:

    Sheets("Sheet1").Rows("1:1").Copy Sheets("Sheet4").Range("A1")

________
Wholesale vaporizers

 

[le888]

No, it doesn't work. Yes, I want to copy the entire row where the cell have a value.

Thanks,

Le

 

[shades]

Which cell? Which value?

Can youu attach a sample worksheet, and show various examples of how you want the results?
________
Buy herbalaire

 

[le888]

Here is the worksheet. I would like the value in first row of the first sheet to be copy in sheet4.

Thanks,

Le

 

[shades]

Okay, that helps. One further clarification. You say that you want to copy the entire first row to Sheet4, but with no empty cells on Sheet4. Then you want to delete the entire first row in Sheet1, Sheet2, Sheet3. Correct?
________
Yamaha p-120 history

 

[le888]

Yes!

Thanks,

Le

 

[shades]

Try this (I started to include the WS counter, but did not delte the row from Sheets1, 2, 3). If you want I can add that.

Sub CopyTest()
    Dim lngWS As Long
    Dim lngLastCell As Long, lngCounter
    
    Sheets("Sheet1").Rows("1:1").Copy Sheets("Sheet4").Range("A1")
    lngLastCell = Sheets("Sheet4").Range("IV1").End(xlToLeft).Column
    For lngCounter = 1 To lngLastCell
        If Cells(1, lngCounter).Value = "" Then _
            Cells(1, lngCounter).Delete
    Next lngCounter
End Sub

It's close, but still misses one cell in the delete portion on Sheet4. Let me work on it for a few minutes.
________
Jaguar xk150 specifications

 

[le888]

The delete part is fine, the problem is the copy part.

 Sheets("Sheet1").Rows("1:1").Copy Sheets("Sheet4").Range("A1")
[CODE]

The line above don't work. 

Thanks,

Le

 

[shades]

Okay this works (I reversed the counter)

Sub CopyTest()
    Dim lngWS As Long
    Dim lngLastCell As Long, lngCounter
    
'    Sheets("Sheet1").Rows("1:1").Copy Sheets("Sheet4").Range("A1")
    Sheets("Sheet4").Activate
    lngLastCell = Sheets("Sheet4").Range("IV1").End(xlToLeft).Column
    For lngCounter = lngLastCell To 1 Step -1
        MsgBox lngCounter
        MsgBox lngLastCell
        If Cells(1, lngCounter).Value = "" Then _
            Cells(1, lngCounter).Delete
    Next lngCounter
    For lngWS = 1 To 3
        Sheets("Sheet" & lngWS).Rows("1:1").Delete Shift:=xlUp
    Next lngWS
        
End Sub

Not sure why the copy/paste is not working. What happens when you step through in the VBE window using the F5 key?
________
Hemp

 

[le888]

well, when I press F5, a popup form with "1" and an O.K. button. I have to press three time to disappear this window.

    Dim lngWS As Long
    Dim lngLastCell As Long, lngCounter
    Dim lngCol As Long
    
    Sheets(1).Rows("1:1").Copy
    Sheets(4).Paste


    For lngWS = 1 To 3
     Sheets(lngWS).Rows("1:1").Delete Shift:=xlUp
    Next lngWS

    For lngCol = 1 To 256
        If IsNull(Sheets(4).cell) Then
         Sheets(4).Col.Delete Shift:=xlLeft
        End If
    Next lngCol

The above code is fine until the last for. I don't know why my if/end condition doesn't work.

Thanks,

Le

 

[shades]

You can add a line above that For loop,

    Application.DisplayAlerts = False

Then be sure to include this before the end of the sub,

    Application.DisplayAlerts = True

Also, note, that by going from 1 to 256, you are going through every column (may not be efficient), so by using the lngLastCell, it only goes as far as the last filled cell.
________
Nutrition Forums

 

[le888]

Thanks, but Excel does'nt delete the empty columns.

Le

 

[shades]

I thought you were getting rid of the cells in Row one on Sheet4, not the entire columns. My misunderstanding.
________
Ferrari f1 642 history

 

[le888]

In other words, I would like the values stick together. As you see in my Excel sheet, the first row has value but not in each cell. So, the thing that I would like to do is to delete the empty cells between two values.

Thanks again,

Le

 

[shades]

Well, that does happen. It cycles through from the first column to the last used column, and if it has not value then it deletes the cell and shifts everything to the left. So no empty cells between the numbers.

Does not the code do that?
________
Xv1600A

 

[le888]

No it don't work. An error on

If IsNull(Sheets(4).cell) Then

Thanks,

Le