Cut single cell and paste to another worksheet range

[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 cut c ell E3 and F3 from Sta Sheet however it only copy to cell Summary B4 and Summary B12. I want it to paste to B4:B11 and B12:B19. 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.

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")
     Worksheets("Sta").Range("F3").Cut Destination:=Worksheets("Summary").Range("B12:B19")
    
    
End Sub

 

[p45cal]

Don't forget to include links to your cross post(s).

 

[vletm]

Dokat
Please reread Forum Rules:

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...

chandoo.org

• Cross-Posting. Generally, it is considered poor practice to cross post. That is to post the same question on several forums in the hope of getting a response quicker.
• If you do cross-post, please put that in your post.
• Also if you have cross-posted and get a Solution elsewhere, have the courtesy of posting the Solution here so other readers can learn from the answer also, as well as stopping people wasting their time on your answered question.

 

[Dokat]

Modified the code as below and it worked

Moderator Note:
Seems You skipped Your Cross-Posting duties.

>>> use code - tags <<<

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").Copy 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")

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


End Sub