简体   繁体   中英

Excel Macro & VBA, Copy Cell Range to another sheet (transposed and based on another value)

I have tried to frankenstein a solution from different threads but I am very much a newbie to VBA and programming, so it has not been going too well...

Here's some basic info:

  • I have 2 Sheets within the same workbook (Database and Data entry)
  • They contain the same headers, but are transposed (Database has the headers in the columns while Data entry has them in the rows)

Now, I am looking for 3 things (ideally in one compact solution)

  1. Have a Command Button that copies and transposes the most recent range (leftmost column) from Data Entry to Database. (This is done in the code below)

  2. This should be done depending on a certain cell value on the data entry sheet (ideally that cell could stay part of the copied range, however this is not crucial)

  3. Delete the original range from the data entry sheet.

As I said I'm just starting to work with VBA so I am completely unsure how to go about this, I have attached what I gathered so far (excludes Nr.2 and feels very cumbersome overall). Any help is very much appreciated!

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    Set xSheet = ActiveSheet
        If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
            xSheet.Range("E6:E200").Copy
            Worksheets("Sheet1").Range("E6:AZ6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If

    Application.ScreenUpdating = True
End Sub

Check this one. It checks the value of E10. If it's "Y", then data is copied and deleted from original place. Otherwise, it shows a message to the user.

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    Set xSheet = ActiveSheet
        If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
            If xSheet.Range("E10")="Y"
                xSheet.Range("E6:E200").Copy
                Worksheets("Sheet1").Range("E6:AZ6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                xSheet.Columns("E").Delete
            Else
                MsgBox("Data entry not ready!")
            End If
        End If

    Application.ScreenUpdating = True
End Sub

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