简体   繁体   中英

Macro to copy certain cells and paste them into a new worksheet

I want to create a macro that is able to copy certain cells dependant on what is in a title cell, "G1". It should then open a new sheet and paste the cells into the same cells in this new worksheet.

Sub CopyCells()
Select Case Range("G1").Value
 Case "PITOT"
  ActiveSheet.Range("D4,D5,D6,D7,D8,D9,D10,D11,I4,I5,I6,I7,I8").Select
  Selection.Copy
  Sheets.Add After:=ActiveSheet
  ActiveSheet.PasteSpecial
 Case "DP FLOW TRANSMITTER"
  ActiveSheet.Range("D4,D5,D6,D7,D8,D9,D10,D11,I4,I5,I6,I7,I8").Select
  Selection.Copy
  Sheets.Add After:=ActiveSheet
 Case Else
 'do nothing
End Select
End Sub

I am getting a 1004 error, is this due to the length of the Range I am attempting to copy or mistakes in the syntax of my code?

The .Copy method cannot be used on multiple selections, that is where you select a range of cells that are not joined together. In your case this is because you are selecting cells in column D and I.

Try instead the following:

Sub CopyCells()
    Set originalSheet = activeSheet
    Set NewSheet = Sheets.Add(After:=activeSheet)

    NewSheet.Range("D4:D11").Value = originalSheet.Range("D4:D11").Value
    NewSheet.Range("I4:I8").Value = originalSheet.Range("I4:I8").Value
End Sub

Note the setting of the worksheets as objects that can be referenced in code, a useful thing to learn. The use of a colon : in range references is a easier way of referencing a number of cells, useful when you are working with larger ranges.

Well, did you read the whole error message? For me it says "This action won't work on multiple selections." That's a dead giveaway, no?

You are trying to select and copy discontiguous ranges, and that won't work. So break it up into steps where the ranges are contiguous.

Copy D4 to D11 first, create the new sheet and paste. Then copy I4 to I8 and paste to the new sheet. You may want to try something like Range("D4:D11") instead of listing each individual cell in a contiguous range. It saves a lot of typing. Just saying.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM