1つのワークシートから別のワークシートにさまざまなセルをコピーし、セルは週ごとに異なります

-2

マクロを使用することの知識は、私が必要とするものだけを記録することにまで及んでいます。 Proposed Future Workコピーシート TEとYRが能力に割り当てられています。 CAP、DES、TE & YRの青色のセルは、コピーと貼り付けが必要です（TEが割り当てられている場合のみ）。次の空白行（斜線領域）... CPC PasteSheet私が使用しているコードは、以下である：サブれるDataTransfer（） ' ' れるDataTransferマクロ 'CPC することが提案転送'1つのワークシートから別のワークシートにさまざまなセルをコピーし、セルは週ごとに異なります

Range("B9:L309").Select 

ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
    Range("K10:K309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
    :=xlSortNormal 
ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
    Range("L10:L309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
    :=xlSortNormal 
ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
    Range("B10:B309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
    :=xlSortNormal 
With ActiveWorkbook.Worksheets("Proposed Future Work").Sort 
    .SetRange Range("B9:L309") 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Rows("12:26").Select 
Selection.EntireRow.Hidden = True 
ActiveWindow.SmallScroll Down:=-18 
Range("K10:L11").Select 
Selection.Copy 
Sheets("CPC-Salam").Select 
Range("BD19").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Sheets("Proposed Future Work").Select 
Range("B10:C11").Select 
Application.CutCopyMode = False 
Selection.Copy 
Sheets("CPC-Salam").Select 
Range("B19:C20").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
Range("B9:BU308").Select 
Application.CutCopyMode = False 
ActiveWorkbook.Worksheets("CPC-Salam").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("CPC-Salam").Sort.SortFields.Add Key:=Range(_ 
    "BD10:BD308"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
ActiveWorkbook.Worksheets("CPC-Salam").Sort.SortFields.Add Key:=Range(_ 
    "BE10:BE308"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
ActiveWorkbook.Worksheets("CPC-Salam").Sort.SortFields.Add Key:=Range(_ 
    "B10:B308"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
    xlSortNormal 
With ActiveWorkbook.Worksheets("CPC-Salam").Sort 
    .SetRange Range("B9:BU308") 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Range("A10").Select 
Sheets("Proposed Future Work").Select 
Range("B10:L11").Select 
Selection.ClearContents 
Rows("11:27").Select 
Selection.EntireRow.Hidden = False 
Range("B9:L309").Select 
ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
    Range("K10:K309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
    :=xlSortNormal 
ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
    Range("L10:L309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
    :=xlSortNormal 
ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
    Range("B10:B309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
    :=xlSortNormal 
With ActiveWorkbook.Worksheets("Proposed Future Work").Sort 
    .SetRange Range("B9:L309") 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
Rows("10:24").Select 
Rows("10:24").EntireRow.AutoFit 
Range("A10").Select

終了サブ

何か提案が歓迎されます

出典

2017-03-21 s.lesser

私はこのサイトを誤解していると思いますが、これは無料のコーディングサービスサイトではありません。あなたはあなたのコードの試行をアップロードする必要があります、私たちはあなたが立ち往生している/エラーを取得し、私たちはあなたを助けるために最善を尽くすことをお知らせください。 –

謝罪、私がそれを貼り付けたと思った –

矛盾しているように見える領域は、TE/YRのない行を隠して、TE/YRの正しいセル数を選択し、正しい空のセルに貼り付けようとしたときですCPC（ペーストシート）。これが私の問題を明確にし、助けてくれることを願っています。もう一度コードを忘れてしまったことを謝ります。シニアの瞬間をしている必要があります –

私は多くの試験の後、私のVBAの問題の答えを見つけて、他の誰かが利用するためにそれを投稿することに決めました。

Sub DataTransfer() 
' 
' DataTransfer Macro 
' Transfer Proposed to CPC 
' 

'Declare variables 
    Dim sht1 As Worksheet 
    Dim sht2 As Worksheet 
'LRCT = Last Row in Copy Tab 
    Dim LRCT As Integer 
'FERPT = First Empty Row in Paste Tab 
    Dim FERPT As Integer 

'Set Variables 
    Set sht1 = ThisWorkbook.Sheets("CPC") 
    Set sht2 = ThisWorkbook.Sheets("Proposed Future Work") 

'Stop the screen flickering 
' With Application 
'  .ScreenUpdating = False 
' End With 

'Apply sort to sheet2 
    sht2.Range("B9:M309").Select 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
     Range("L10:L309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
     :=xlSortNormal 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
     Range("M10:M309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
     :=xlSortNormal 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
     Range("B10:B309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
     :=xlSortNormal 
    With ActiveWorkbook.Worksheets("Proposed Future Work").Sort 
     .SetRange Range("B9:M309") 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

'Find the last row with data in column K, sheet 2 
    With sht2 
    LRCT = .Cells(.Rows.Count, "L").End(xlUp).Row 
    End With 

'Find the first empty row in column BD, sheet 1 
    With sht1 
    FERPT = .Cells(.Rows.Count, "BD").End(xlUp).Row 
    FERPT = FERPT + 1 
    End With 

'Copy data in sheet 2, starting from cell K10 to the last cell in column L 
    sht2.Range("L10:M" & LRCT).Copy 
'Paste data into sheet 1 column BD, starting from the first empty cell in column BD. 
    sht1.Range(("BD" & FERPT)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

'Copy data in sheet 2, starting from cell B10 to the last cell in column L 
    sht2.Range("B10:C" & LRCT).Copy 
'Paste data into column B sheet 1, starting from the first empty cell in column BD. 
    sht1.Range(("B" & FERPT)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

'Clear clipboard 
    Application.CutCopyMode = False 

'Remove copied data from sheet 2 
    sht2.Range("L10:M" & LRCT).ClearContents 
    sht2.Range("B10:C" & LRCT).ClearContents 

'sort data in sheet1 
    Sheets("CPC").Select 
    Range("B9:BV309").Select 
    ActiveWorkbook.Worksheets("CPC").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("CPC").Sort.SortFields.Add Key:=Range(_ 
     "BD10:BD309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
     xlSortNormal 
    ActiveWorkbook.Worksheets("CPC").Sort.SortFields.Add Key:=Range(_ 
     "BE10:BE309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
     xlSortNormal 
    ActiveWorkbook.Worksheets("CPC").Sort.SortFields.Add Key:=Range(_ 
     "B10:B309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
     xlSortNormal 
    With ActiveWorkbook.Worksheets("CPC").Sort 
     .SetRange Range("B9:BV309") 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

'sort data in sheet 2 
    Sheets("Proposed Future Work").Select 
    Range("B9:M309").Select 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
     Range("L10:L309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
     :=xlSortNormal 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
     Range("M10:M309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
     :=xlSortNormal 
    ActiveWorkbook.Worksheets("Proposed Future Work").Sort.SortFields.Add Key:= _ 
     Range("B10:B309"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ 
     :=xlSortNormal 
    With ActiveWorkbook.Worksheets("Proposed Future Work").Sort 
     .SetRange Range("B9:M309") 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

'Update the screen 
    With Application 
     .ScreenUpdating = True 
    End With 

End Sub

出典

2017-03-27 15:28:25

1つのワークシートから別のワークシートにさまざまなセルをコピーし、セルは週ごとに異なります

答えて

関連する問題