Cut single sell paste to a range with VBA

[Dokat]

Hi,


I am trying to rearrange columns and rows in a worksheet. I am using below code to automate the process. It worked seamlessly when I ran the code on same worksheet. However when I cut and paste to another worksheet It doesn't run properly.

It want to cut cell E3 and F3 from Sta Sheet and copy to Worksheet.(Summary").Range B4:B11, and B12:B19. However below code only paste it to B4 and B12. Can anyone help me modify the code so it paste to entire range.

Worksheet Sta is Source Data
Worksheet Summary is where i want to cut and paste the ranges.

Code:
Sub MoveRangeSta()

Dim iCntr
Dim rng As Range
Set rng = Worksheets("Summary").Range("C4:F1111")

For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next

Worksheets("Sta").Range("C4:C12").Cut Destination:=Worksheets("Summary").Range("C4")
Worksheets("Sta").Range("E4:E12").Cut Destination:=Worksheets("Summary").Range("D4")
Worksheets("Sta").Range("C4:C12").Cut Destination:=Worksheets("Summary").Range("C12")
Worksheets("Sta").Range("F4:F12").Cut Destination:=Worksheets("Summary").Range("D12")

Worksheets("Sta").Range("E3").Cut Destination:=Worksheets("Summary").Range("B4:B11")

I posted this on another forum below is the link.

Cut single cell and paste to another worksheet range

Hi, I am trying to rearrange columns and rows in a worksheet. I am using below code to automate the process. It worked seamlessly when I ran the code on same worksheet. However when I cut and paste to another worksheet It doesn't run properly. It cut c ell E3 and F3 from Sta Sheet however it...

chandoo.org

Worksheets("Sta").Range("F3").Cut Destination:=Worksheets("Summary").Range("B12:B19")


End Sub

 

[Fluff]

Try it like

   With Worksheets("Sta")
      .Range("E3").Copy Worksheets("Summary").Range("B4:B11")
      .Range("E3").Clear
      .Range("F3").Copy Worksheets("Summary").Range("B12:B19")
      .Range("F3").Clear
   End With

 

[Dokat]

Thank you for your reply I replaced Copy with Cut and it worked. Thanks for your help.

 

[Fluff]

If you cut & paste you are removing the values from E3 & F3, which is what my code does.
if you want to keep those values intact, then just remove the two lines that clear the cell

 

[Dokat]

If you cut & paste you are removing the values from E3 & F3, which is what my code does.
if you want to keep those values intact, then just remove the two lines that clear the cell

I applied the code to actual data set and now i am having same issue where it is not copy pasting the values in W22 and AB22 to the specified range,

Please see below. I'd like Worksheet.("WBC").Range("W22") to copy paste to Worksheets("Summary").Range("B4:B38"). It returns blank. Can you please help.

=]Sub MoveRangeWBC()

Worksheets("WBC").Range("E25:E80").Copy Destination:=Worksheets("Summary").Range("C4")
Worksheets("WBC").Range("W25:W80").Copy Destination:=Worksheets("Summary").Range("D4")
Worksheets("WBC").Range("E25:E80").Copy Destination:=Worksheets("Summary").Range("C39")
Worksheets("WBC").Range("AB25:AB80").Copy Destination:=Worksheets("Summary").Range("D39")

With Worksheets("WBC")
Range("W22").Copy Worksheets("Summary").Range("B4:B38")
Range("W22").Clear
Range("AB22").Copy Worksheets("Summary").Range("B39:B74")
Range("AB22").Clear

Dim iCntr
Dim rng As Range
Set rng = Worksheets("Summary").Range("B4:F1111")

For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next

End With
End Sub

 

[Fluff]

You need to put a full stop in front of the ranges in the with statement (as seen in post#2) otherwise it's looking at the active sheet.

 

[Dokat]

I applied the code to actual data set and now i am having same issue where it is not copy pasting the values in W22 and AB22 to the specified range,

Please see below. I'd like Worksheet.("WBC").Range("W22") to copy paste to Worksheets("Summary").Range("B4:B38"). It returns blank. Can you please help.

=]Sub MoveRangeWBC()

Worksheets("WBC").Range("E25:E80").Copy Destination:=Worksheets("Summary").Range("C4")
Worksheets("WBC").Range("W25:W80").Copy Destination:=Worksheets("Summary").Range("D4")
Worksheets("WBC").Range("E25:E80").Copy Destination:=Worksheets("Summary").Range("C39")
Worksheets("WBC").Range("AB25:AB80").Copy Destination:=Worksheets("Summary").Range("D39")

With Worksheets("WBC")
Range("W22").Copy Worksheets("Summary").Range("B4:B38")
Range("W22").Clear
Range("AB22").Copy Worksheets("Summary").Range("B39:B74")
Range("AB22").Clear

Dim iCntr
Dim rng As Range
Set rng = Worksheets("Summary").Range("B4:F1111")

For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next

End With
End Sub

Nevemind modified little bit and change the order of actions, code is working now.

Sub MoveRangeWBC()



Worksheets("WBC").Range("E25:E60").Copy Destination:=Worksheets("Summary").Range("C4")
Worksheets("WBC").Range("W25:W60").Copy Destination:=Worksheets("Summary").Range("D4")
Worksheets("WBC").Range("E25:E60").Copy Destination:=Worksheets("Summary").Range("C39")
Worksheets("WBC").Range("AB25:AB60").Copy Destination:=Worksheets("Summary").Range("D39")

Dim iCntr
Dim rng As Range
Set rng = Worksheets("Summary").Range("B4:F1111")

For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
Next

Worksheets("WBC").Range("W22").Copy Worksheets("Summary").Range("B4:B33")
Worksheets("WBC").Range("AB22").Copy Worksheets("Summary").Range("B34:B64")


End Sub

 

[Dokat]

You need to put a full stop in front of the ranges in the with statement (as seen in post#2) otherwise it's looking at the active sheet.

Ok so i have to put .(dot) in front of the ranges so that it doesnt look at the active sheet. Thanks for your helo

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Dokat]

You are welcome. However I am still having the same issue, W22, AB22 still is not copying to B4:B33,B34:B64. What maybe causing this issue? Below is the code i am trying.

Sub MoveRangeWBC()

Worksheets("WBC").Range("E25:E60").Copy Destination:=Worksheets("Summary").Range("C4")
Worksheets("WBC").Range("W25:W60").Copy Destination:=Worksheets("Summary").Range("D4")
Worksheets("WBC").Range("E25:E60").Copy Destination:=Worksheets("Summary").Range("C39")
Worksheets("WBC").Range("AB25:AB60").Copy Destination:=Worksheets("Summary").Range("D39")

Dim iCntr
Dim rng As Range
Set rng = Worksheets("Summary").Range("B4:F1111")

For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete

Next

With Worksheets("WBC")
.Range("W22").Copy Worksheets("Summary").Range("B4:B33")
.Range("W22").Clear
.Range("AB22").Copy Worksheets("Summary").Range("B34:B64")
.Range("AB22").Clear



End With

End Sub