Copy and paste VBA issue

Excel_Blonde

New Member
Joined
Aug 8, 2018
Messages
44
Hi all,

Can anyone help with the below code. I'm trying to look through all sheets across the range G4:K4 and move any data from the cells into I4. There is only 1 cell with data but it can be in any cell of the range.
It seems to work if I manually select a sheet and run the code, but doesn't automatically work across all sheets as intended. I'm sure it's something silly i'm missing but I just cant see it.


Sub Movepartcodetrial()


Dim ws As Worksheet


For Each ws In Worksheets
If Range("G4") <> "" Then
Range("G4").Cut Range("I4")
ElseIf Range("H4") <> "" Then
Range("H4").Cut Range("I4")
ElseIf Range("J4") <> "" Then
Range("J4").Cut Range("I4")
ElseIf Range("K4") <> "" Then
Range("K4").Cut Range("I4")
End If
Exit For
Next ws


End Sub

Any help would be appreciated.
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
You are stopping the code from going to the next sheet since you have Exit For. Try removing it and see if your code does what you want.
 
Upvote 0
Do those cells contain formulas?
If so is the result numeric or text?
 
Upvote 0
Thanks for your quick responses.

Removing Exit For does make a difference but it doesn't run through all sheets, I think its finding the first instance and changing only that one.

The data is from a report exported into excel but it doesn't export very well. I'm using a code to un-merge all cells prior to running this code.

There are no formula's, the data being moved can be text or numeric values, sometimes a mixture of the two.
 
Last edited:
Upvote 0
Ok, how about
Code:
Sub Excel_Blonde()
   Dim ws As Worksheet
   
   For Each ws In Worksheets
      On Error Resume Next
      With ws.Range("G4:H4,J4:K4").SpecialCells(xlConstants)
         ws.Range("I4").Value = .Value
         .ClearContents
      End With
      On Error GoTo 0
   Next ws
End Sub
 
Upvote 0
Seems to be working perfectly! Thank you very much. Would you mind looking at the next part of my issue? Now i have the data in I4 I want to rename the sheets to that information. The issue is there can be more than 1 of the same name, I've gotten as far as the below code but now its returning an error on ws.Name = wsname (Name already taken).

Sub RenameSheets1()


Dim ws As Worksheet, wscount As Integer, wsname As String, dict
Set dict = CreateObject("scripting.Dictionary")


For Each ws In Sheets
If ws.Name <> "List" Then
If ws.Range("I4") <> "" Then
wsname = Replace(ws.Range("I4"), "/", "")
wscount = IIf(dict.Exists(wsname), dict(wsname) + 1, 1)
dict(wsname) = wscount
If wscount = 1 Then
ws.Name = wsname
Else
If wscount = 2 Then Sheets(wsname).Name = wsname & -1
End If
End If
End If

Next ws
End Sub

Sorry, I've spent about 3 days now trying to get various parts of a larger Macro to work, but my knowledge is very limited and searches have gotten me as far as I can go I think.
 
Upvote 0
How about
Code:
Sub Excel_Blonde()
   Dim ws As Worksheet
   Dim ShtName As String
   
   With CreateObject("scripting.dictionary")
      For Each ws In Worksheets
         If ws.Name <> "List" Then
            On Error Resume Next
            With ws.Range("G4:H4,J4:K4").SpecialCells(xlConstants)
               ws.Range("I4").Value = .Value
               .ClearContents
            End With
            On Error GoTo 0
            ShtName = Replace(ws.Range("I4").Value, "/", "")
            .Item(ShtName) = .Item(ShtName) + 1
            ws.Name = ShtName & "(" & .Item(ShtName) & ")"
         End If
      Next ws
   End With
End Sub
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,213,495
Messages
6,113,992
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top