PDA

View Full Version : [SOLVED] Having trouble performing a few tasks in VBA, possibly need a loop?



NUTSUECOW
11-26-2018, 01:41 PM
I need to run this series of events 40 times. after each time it runs, range J1 needs to go down to J2. And the paste portion at the bottom needs to move from M30 to M40. Repeating to J3, and M50 ect..... 40 times. I'm not sure if I could use the match somehow to help with this. Having trouble wrapping my head around this. any help would be appreciated.

23271



Sub Copy_Paste()
'
' OT_REFRESH_EXPORT Macro
'


Worksheets("Data").Activate




If Range("J1").Value = "Package1" Then
Range("$P$2").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy



ElseIf Range("J1").Value = "Package2" Then
Range("$P$4").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package3" Then
Range("$P$6").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package4" Then
Range("$P$8").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package5" Then
Range("$P$10").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package6" Then
Range("$P$12").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package7" Then
Range("$P$14").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package8" Then
Range("$P$16").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package9" Then
Range("$P$18").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package10" Then
Range("$P$20").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package11" Then
Range("$P$22").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package12" Then
Range("$P$24").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy


ElseIf Range("J1").Value = "Package13" Then
Range("$P$26").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy

End If


Range("M30").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
END SUB

NUTSUECOW
11-26-2018, 01:46 PM
Essentially i need to recognize what package is in Column J, and paste the associated data from that package for each one starting at M30, then it has to start M40, ect....

Paul_Hossler
11-26-2018, 03:25 PM
1. Welcome to the forum - please read the FAQs in my sig

2. Please use CODE tags around your macro(s) -- use the [#] icon to insert them and paste the macro between

3. A sample workbook makes things a lot easier


4. I'd be VERY surprised if this works, but it might give you some ideas




Option Explicit

Sub Copy_Paste()
Dim r1 As Range, r2 As Range, r3 As Range
Dim i As Long, n As Long

With Worksheets("Data")
For i = 1 To 40
Set r1 = .Cells(i, 10) ' col J, rows 1,2,3, ... 40

n = CLng(Right(r1.Value, Len(r1.Value) - 7)) ' delete "Package" leave number, 1,2,3, ... 13

Set r2 = .Cells(2 * n, 16) ' col P, rows 2,4,6,... 80
r2.Offset(0, 1).Resize(1, 10).Copy
Set r3 = .Cells(i * 10 + 20, 13) ' col M, rows 30, 40, 50, ...

r3.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next i
End With
End Sub

Daxton A.
11-26-2018, 05:51 PM
For i = 1 To 40
Select Case Range("J1").Text
Case Is = "Package1"
Range("$P$2").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy
Case Is = "Package2"
Range("$P$4").Select
ActiveCell.Offset(, 1).Resize(1, 10).Copy
'...
End Select
Next I