常連

自己紹介

```
 'Sh1のデータをオートフィルターする
    With Sh1.Range("A1")
     .AutoFilter field:=1, Criteria1:=keyWord
     .CurrentRegion.Offset(1, 0).Resize(.CurrentRegion.Rows.Count - 1, 29).Select
     .Range("A:A, C:C, K:K, O:P, S:S, U:U, AA:AC").Copy
    End With
```
＜やりたいこと＞
A列からAC列まであるデータで、オートフィルター後、A,C,K,O:P,S,U,AA:ACだけを
Sheet2に転記したいです。

＜エラー箇所＞
上記を実行しますと、Sheet1でフィルターをかけた見出し(１行目）までコピーされてしまいました。

VBA データ抽出しコピー

### 前提
パワーポイントのスライド上にカウントダウンタイマーを表示したいときがあり、
ネットを参考に、作ってみました。

図形をクリックすることで分と秒を指定し、
大きい四角をクリックするとカウントダウンが始まるところまで
出来ました。

![![イメージ説明](2b21ded24209516e3916ef1c28ad707c.png)　図形の書式―オブジェクトの選択と表示で図形にTimerShape,　ResetShape,　MinutesShape,　SecondsShapeと名前つけています。挿入―動作で図形をクリックするとマクロが動くよう関連付けています](9b70ef9bb5c7444b74310e0c6f2dd7a5.png)](6db2d64d0985d96d5ad9333f1eb87409.png)
### 実現したいこと
実現したいことが2つあります。

0. カウントダウンの途中で止めることができるよう改造したいのですが、上手く行きません。
0. カウントダウン用スライドを1ファイルの任意の場所に、複数おいても動くようにしたい。

### 発生している問題・エラーメッセージ


### 該当のソースコード

```VBA
Option Explicit
Dim Minutes As Long
Dim Seconds As Long
'Dim tempStop As Boolean

'-----------何分のカウントダウンか設定する--------------------------

Sub SetMinutes()
    If Minutes < 59 Then
        Minutes = Minutes + 1
        Else
        Minutes = 0
    End If
    
    ActivePresentation.Slides(1).Shapes("MinuteShape").TextFrame.TextRange.Text = Minutes & " min"
 Debug.Print (Minutes & ":" & Seconds)
End Sub

'-----------何秒かのカウントダウンか設定する--------------------------

Sub SetSeconds()

    If Seconds < 50 Then
        Seconds = Seconds + 10
    Else
        Seconds = 0
    End If

ActivePresentation.Slides(1).Shapes("SecondsShape").TextFrame.TextRange.Text = Seconds & " s"

Debug.Print (Minutes & ":" & Seconds)
End Sub

'-----------リセットする--------------------------

Sub Reset()
Minutes = 0
Seconds = 0

    ActivePresentation.Slides(1).Shapes("MinuteShape").TextFrame.TextRange.Text = Minutes & " min"
    ActivePresentation.Slides(1).Shapes("SecondsShape").TextFrame.TextRange.Text = Seconds & " s"
Debug.Print (Minutes & ":" & Seconds)
End Sub
'-----------カウントダウン--------------------------
Sub CountDown()

Dim EndTime As Date

'tempStop = False

Seconds = Minutes * 60 + Seconds
EndTime = DateAdd("s", Seconds, Now())

    Do Until EndTime <= Now()
        DoEvents
   
        ActivePresentation.Slides(1).Shapes("TimerShape").TextFrame.TextRange.Text = Format((EndTime - Now()), "nn:ss")
        
'        If tempStop = True Then
'        Exit Sub
'      End If
        
    Loop

End Sub

'Sub JudgeStop()
'
'  tempStop = True
'
'End Sub

```

### 試したこと

1については、判定用の変数tempStopを用意し、それがtrueならループを抜けるように書いてみましたが、上手く行きません。

2については、現時点では、スライドの位置(スライド番号)は固定なのが問題だと考え、「ActivePresentation.Slides(1).」の部分を 「ActiveWindow.Selection.SlideRange.」に変更しました。しかし、そうすると、図形を押しても反応しなくなりました。

なにぶん初心者ですので、お手上げです。
### 補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Powerpoint　VBAで作ったカウントダウンタイマーに①一時停止ボタンをつけたい。②スライドごと複製しても使えるようにしたい。

#内容

EXCELシート上に、デスクトップ画面のスクリーンショットを
SHAPE画像で表示させるプログラムを作成しました。

#検討内容

結局のところ、VBA単体では難しかったので、C#でdllを書きました。

C#のDLLで、戻り値をBASE64の文字列にしています。
VBA側は、BASE64をファイルに落としてデコードしています。

結局のところ、ライブラリを作っても、ファイルに落とさないと
これが実現できないので、スマートではないと思っています。

#相談事項
　
C#の戻り値を、EXCELのSHAPEオブジェクトにして、
直接、VBAからSHAPEの貼り付けはできないものでしょうか？

どうもc#側で、EXCELのオブジェクトを扱う方法が分かりません。

#PS

今回、初めてｃ＃を触ったので、そもそもDLLも初めてです。
ただし、感触としてはVBAをこね回すよりも、C#側でやりたいことを増やした方が良いように思います。

いままでCOMの操作だけでは、満足いくものができなかったのですが
少し、プログラムの幅が広がりそうな気がします。

すみませんが、初学者にアドバイスをお願い致します。



```C#
using System;
using System.Collections.Generic;
using System.Linq;
using System.Net;
using System.Runtime.InteropServices;
using System.Text;
using System.Threading.Tasks;
using System.Drawing.Imaging;
using System.Diagnostics;
using System.Drawing;
using System.Windows.Forms;
using System.IO;

namespace ClassLibraryForVBA
{
    [Guid(ScreenShot.ClassId)]
    public class ScreenShot
    {
        public const string ClassId = "9E873B7A-6636-4448-B9BB-23BE3AE1F28B";
        public string GetScreen(int number)
        {
            Rectangle rc = System.Windows.Forms.Screen.AllScreens[number].WorkingArea;
            Bitmap bmp = new Bitmap(rc.Width, rc.Height, PixelFormat.Format32bppArgb);
            using (Graphics g = Graphics.FromImage(bmp))
            {
                g.CopyFromScreen(rc.X, rc.Y, 0, 0, rc.Size, CopyPixelOperation.SourceCopy);
            }

            var SigBase64 = "";
            using (var ms = new MemoryStream())
            {
                bmp.Save(ms, ImageFormat.Bmp);
                SigBase64 = Convert.ToBase64String(ms.GetBuffer());
            }
            return SigBase64;
        }
        public int Count()
        {
            return Screen.AllScreens.Length;
        }
        public int Height(int number)
        {
            return System.Windows.Forms.Screen.AllScreens[number].WorkingArea.Height;
        }
        public int Width(int number)
        {
            return System.Windows.Forms.Screen.AllScreens[number].WorkingArea.Width;
        }
    }
}   
```

```VBA
Option Explicit

Sub GetPageHtml()
 
  ' .NETライブラリのクラスをインスタンス化
Dim wp As New ClassLibraryForVBA.ScreenShot
Dim arr

arr = wp.getscreen(0)
Debug.Print wp.Height(0), wp.Width(0)
put_shape (arr)

arr = wp.getscreen(1)
Debug.Print wp.Height(1), wp.Width(1)
put_shape (arr)

End Sub

 
Sub put_shape(arr)
Dim strTempPath
strTempPath = Application.ActiveWorkbook.Path & "\temp.png"
Open strTempPath For Binary As #1
Put #1, 1, DecodeBase64(arr)
Close #1

Sheets("Sheet1").Pictures.Insert strTempPath

End Sub
 

Private Function DecodeBase64(ByVal strData As String) As Byte()

    Dim objXML As Object 'MSXML2.DOMDocument
    Dim objNode As Object 'MSXML2.IXMLDOMElement

    'get dom document
    Set objXML = CreateObject("MSXML2.DOMDocument")

    'create node with type of base 64 and decode
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.Text = strData
    DecodeBase64 = objNode.nodeTypedValue

    'clean up
    Set objNode = Nothing
    Set objXML = Nothing

End Function


```

EXCEL VBA でデスクトップスクリーン画像を、セルに表記させる方法

#VBAで3つのファイルパスを文字列引数として渡したい

C#で作ったCOMライブラリを呼び出しています。

引数を渡す部分で、エラーになります。

C#から呼び出したTEST.EXEでは問題なく、受け渡しができていました。
VBAで実施すると下記のエラーが出ます。

```error

実行時エラー　'-2147467261(80004003)'
値をNullすることができません。パラメータ名：path

```

#課題

文字列３つを参照渡しして、戻り値のx,y座標をPOINT構造体で受け取る予定です。
DLLのコールの仕方は初めてなのでよくわかりません。

何か参考になるソースがあれば、教えて頂きたく思います。

```VBA
Option Explicit

Public Type Point
x As Integer
y As Integer
End Type

        
Sub test()
        Dim file1, file2, file3
        Dim shot
        Dim x
        
            str file1 = "C:\Users\mm05162\Desktop\after.bmp"
            str file2 = "C:\Users\mm05162\Desktop\before.bmp"
            str file3 = "C:\Users\mm05162\Desktop\drop.bmp"
            Set shot = New ScreenShot
            x = shot.Imagediff(file1, file2, file3)
            
End Sub

```

```C#

using System;
using System.Collections.Generic;
using System.Drawing;
using System.IO;
using System.Linq;
using System.Runtime.InteropServices;
using OpenCvSharp;
using Point = OpenCvSharp.Point;

namespace ClassLibraryForVBA
{
    [Guid(ScreenShot.ClassId)]
    public class ScreenShot
    {
        public const string ClassId = "74EA63A0-15B2-42F4-9603-A5033599C4D6";
        private OpenCvSharp.Point[][] contours;

        public System.Drawing.Point Imagediff(string a, string b, string c)
        {
            string file1 = Path.GetFullPath(a);
            string file2 = Path.GetFullPath(b);
            string file3 = Path.GetFullPath(c);
            using (Mat image1 = Cv2.ImRead(file1))
            using (Mat image2 = Cv2.ImRead(file2))
            using (Mat image_drop = Cv2.ImRead(file3))
            using (Mat diff = new Mat(new OpenCvSharp.Size(image1.Cols, image1.Rows), MatType.CV_8UC3))

                try
                {
                    Cv2.Absdiff(image1, image2, diff);
                    var result = new Mat();
                    Mat mask = Mat.Zeros(image_drop.Size(), MatType.CV_8UC3);
                    Cv2.MatchTemplate(diff, image_drop, result, TemplateMatchModes.CCoeffNormed);
                    Cv2.Threshold(result, result, 0.8, 1.0, ThresholdTypes.Binary);
                    Cv2.MinMaxLoc(result, out OpenCvSharp.Point minPoint, out OpenCvSharp.Point maxPoint);
                    Rect rect = new Rect(maxPoint.X, maxPoint.Y, image_drop.Width, image_drop.Height);
                    Cv2.Rectangle(diff, rect, new OpenCvSharp.Scalar(0, 0, 0), -1);
                    Cv2.CvtColor(diff, diff, ColorConversionCodes.BGR2GRAY);
                    Cv2.Threshold(diff, diff, 20, 255, ThresholdTypes.Binary);
                    diff.FindContours(out contours, out HierarchyIndex[] hierarchy, RetrievalModes.External, ContourApproximationModes.ApproxSimple);

                    List<Point> points = new List<Point>();
                    for (int idx_cnt = 0; idx_cnt < contours.GetLength(0); ++idx_cnt)
                    {
                        if (hierarchy[idx_cnt].Parent != -1) { continue; }
                        points.AddRange(contours[idx_cnt]);
                    }
                    var avgPoint = new System.Drawing.Point
                    {
                        X = (int)Math.Round(points.Average(p => p.X)),
                        Y = (int)Math.Round(points.Average(p => p.Y))
                    };
                    return avgPoint;
                }
                catch (Exception)
                {
                    var ans = new System.Drawing.Point
                    {
                        X = 0,
                        Y = 0
                    };
                    return ans;
                }
        }
    }
}

```
```c#

テストコード

using System.Runtime.InteropServices;
using System.IO;
using System.Drawing;
using ClassLibraryForVBA;


namespace im_test
{
    class Program
    {
        static void Main()
        {   
            string file1 = Path.GetFullPath(@"C:\Users\mm05162\Desktop\after.bmp");
            string file2 = Path.GetFullPath(@"C:\Users\mm05162\Desktop\before.bmp");
            string file3 = Path.GetFullPath(@"C:\Users\mm05162\Desktop\drop.bmp");
            var shot = new ScreenShot();
            Point x = shot.Imagediff(file1, file2, file3);
       
        }
    }
}
```

C# で作ったOPENCV汎用DLLに、VBAからアクセス

### 前提・実現したいこと

VBAで取得済みIEのHTMLを取得すること

### 発生している問題・エラーメッセージ

```
＜HTMLの取得について＞

Call tagClick(objIE, "a", "文字列１")
はうまくいくのですが、

Debug.PrintobjIE.document.all(0).outerHTML
Call tagClick(objIE, "a", "文字列２")
がうまくいきません。エラーは出ませんが、リンクをクリックできません。
```

### 該当のソースコード

```VBA


'-----------------------Main------------------------
Sub Main()
    Dim objIE As InternetExplorer
    Dim objLink As Object
    
    Call ieView(objIE, "ログイン画面のURL")

    objIE.document.getElementsByName("IDのHTML")(0).Value = "ID"
    objIE.document.getElementsByName("PASSのHTML")(0).Value = "PASS"
    objIE.document.getelementbyid("ログインボタンのHTML").Click
        
    Set objIE = 最新画面
    Call ieCheck(objIE)
    Call tagClick(objIE, "a", "文字列１")

    Set objIE = 最新画面
    Call ieCheck(objIE)
    


'以下問題個所　↓>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>



    Debug.Print "  URL:" & objIE.document.Url
    Debug.Print objIE.document.all(0).outerHTML
    
    Call tagClick(objIE, "a", "文字列２")

'問題点_______________________________________________
Call tagClick(objIE, "a", "文字列１")
はうまくいくのですが、

Debug.PrintobjIE.document.all(0).outerHTML
Call tagClick(objIE, "a", "文字列２")
がうまくいきません。

IEオブジェクトを紛失していると思い、再取得のコードを付け加えた（最新画面）のですが、うまくいきませんでした。Debug.Print "  URL:" & objIE.document.Url
で操作したいIEオブジェクト(objIE)を掴んでいることは確認済みです。しかし、そのIEオブジェクトのHTMLが一切操作できません。機密性の問題でしょうか？ 
'_________________________________________________




'以上問題個所　↑>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


    
    
End Sub
'-----------------ieView----------------------
Sub ieView(objIE As InternetExplorer, urlName As String, Optional viewFlg As Boolean = True)
    Debug.Print ">>> ieView"
    Set objIE = CreateObject("InternetExplorer.Application")

    objIE.Visible = viewFlg

    objIE.navigate urlName

    Call ieCheck(objIE)
End Sub
'-----------------ieCheck-------------------
Sub ieCheck(objIE As InternetExplorer)
    Debug.Print ">>> ieCheck"
    Dim timeOut As Date
    timeOut = Now + TimeSerial(0, 0, 20)
    Do While objIE.Busy = True Or objIE.readyState <> 4
        DoEvents
        If Now > timeOut Then
            objIE.Refresh
               timeOut = Now + TimeSerial(0, 0, 20)
        End If
    Loop
    timeOut = Now + TimeSerial(0, 0, 20)
    Do While objIE.document.readyState <> "complete"
        DoEvents
        If Now > timeOut Then
            objIE.Refresh
            timeOut = Now + TimeSerial(0, 0, 20)
        End If
    Loop
End Sub
'---------------------tagclick------------------
Sub tagClick(objIE As InternetExplorer, tagName As String, tagStr As String)
    Debug.Print ">>> tagclick"

    Dim objTag As Object

    For Each objTag In objIE.document.getElementsByTagName(tagName)
        Debug.Print "      L___ " & objTag.innerHTML
        If InStr(objTag.outerHTML, tagStr) > 0 Then
            objTag.Click
            Call ieCheck(objIE)
            Exit For
        End If
    Next
End Sub
'--------------------最新画面-----------------
Function 最新画面() As Object
    Debug.Print ">>> 最新画面"
    Dim objShell As Object, n As Long
    Set objShell = CreateObject("Shell.Application")
    For n = objShell.Windows.Count To 1 Step -1
        If TypeName(objShell.Windows(n - 1).document) = "HTMLDocument" Then
            Set 最新画面 = objShell.Windows(n - 1)
            Exit For
        End If
    Next n
    Debug.Print "      L___ Title: " & 最新画面.document.Title
    Set objShell = Nothing
    
    
 
    
End Function
'----------------------getLink-------------------
Sub goLink(objIE As InternetExplorer, str As String)
    Debug.Print ">>> goLink: " & str
    For Each Tag In objIE.document.getElementsByTagName("a")
        If InStr(Tag.innerHTML, str) > 0 Then
            Tag.Click
            Call ieCheck(objIE)
            Exit For
        End If
    Next
End Sub



```

### 試したこと

IEオブジェクトを紛失していると思い、再取得のコードを付け加えた（最新画面）のですが、うまくいきませんでした。
Debug.Print "  URL:" & objIE.document.Url
で操作したいIEオブジェクト(objIE)を掴んでいることは確認済みです。
しかし、そのIEオブジェクトのHTMLが一切操作できません。機密性の問題でしょうか？ 

### 補足情報（FW/ツールのバージョンなど）
Excel 2016 32 bit
InternetExplorer　11
サイトの保護モードはすべて有効

VBAで取得済みIEのHTMLを取得する

### 前提・実現したいこと

D列に入力されたらA列に「シート名+連番」が入るようにする

### 発生している問題・エラーメッセージ

マクロを有効にしてなかったため作業者がのちほどD列をコピーペーストすると連番ではなくなってしまいます

重複する場合が出てきてしまい困っております。

D列をコピーペーストした場合でも連番にする方法はありますでしょうか
ご教授宜しくお願いいたします。

### 該当のソースコード

一部抜粋でしてます
必要でしたら全文載せます

```ここに言語名を入力
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

        Dim MyRNG As Range
        Dim k As Long
        Dim sn As String

        Application.EnableEvents = False


        k = Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        sn = ActiveSheet.Name

If Not Intersect(Target, Range("D5", Cells(Rows.Count, "D"))) Is Nothing Then

            For Each MyRNG In Intersect(Target, Range("D5", Cells(Rows.Count, "D")))
                If MyRNG.Value = "" Then
                    Cells(MyRNG.Row, "A").Resize(, 3).Value = "" 
                Else
                    If MyRNG.Offset(, -3).Value = "" Then MyRNG.Offset(, -3).Value = sn & k - 10
                End If
            Next MyRNG

        End If

```


### 補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

連番で管理させるには

### 前提・実現したいこと

pythonのxlwingsを使用し、以下のプログラムを作成しています。
(1) excelで選択中のセルの値を取得
(2) DataFrameに変換
(3) csv出力

### 発生している問題
csv出力した際にテキストフォーマットが変更されてしまいます。
ソースコードのcells.valueに問題があるようです。
元のフォーマットを維持するためにはどうすればよいでしょうか？

```
excelの値
2020/2/1 9:00	1
2020/2/1 9:01	2

理想の出力
2020/2/1 9:00, 1
2020/2/1 9:01, 2

現在の出力
2020-02-01 09:00:00, 1.0
2020-02-01 09:01:00, 2.0

```

### 該当のソースコード

```python
import pandas as pd
import xlwings as xw

workbooks = xw.books
wb = workbooks.active
cells = wb.selection

df = pd.DataFrame(cells.value)
df.to_csv('result.csv', header=False, index=False)
```

xlwings: テキストフォーマットを維持する方法

### 前提・実現したいこと

VBAの事が全く解っていないので意味不明な事を言ってるかもしれませんが宜しくお願い致します。


Book1（商品管理）にある（一覧）というsheetにAからAGまでデーターが入って有り（空白が所々あるうえ毎日追加していきます）
フィルターで抽出したデーターを別ブックBook2（移動伝票）の（移動データー）というsheetの既存データの下に今回抽出したデータを追記していきたいのですが貼り付けがうまくいきません。


 Set FromRng = .Range(Range("A8"), Cells(Rows.Count, 33).End(xlUp))の所でエラーが出ていて
抽出したデーターをコピーする時のコピー指定がおかしいのでしょうか？



色々自分なりに調べて組み合わせたコードなので変な箇所など多々あると思いますが宜しくお願い致します。




### 発生している問題・エラーメッセージ

```
・アプリケーション定義またはオブジェクト定義のエラーです。
```

### 該当のソースコード

```
Private Sub CommandButton1_Click()

Unload UserForm2

Application.ScreenUpdating = False

Dim clm As Range
Dim id As Range
Dim i As Long
Dim stTestFile As String

stTestFile = "C:¥新しいフォルダー¥移動伝票.xlsx"

With ThisWorkbook.Worksheets("一覧")
    Set clm = .Range(.Cells(8, 31), .Cells(.Rows.Count, 31).End(xlUp))
    Set id = clm.Find(What:="未", lookat:=xlWhole)
End With

Workbooks.Open Filename:=stTestFile
    If ActiveWorkbook.ReadOnly Then
    
        MsgBox "他の人が使用中です。"
        ActiveWorkbook.Close
    Else
    
    If Not id Is Nothing Then
                
     With ThisWorkbook.Worksheets("一覧")
        .Range("A7").AutoFilter 31, "未"
        .Range("A7").AutoFilter 8, "卯"
     End With

    Dim FromRng As Range
     With ThisWorkbook.Worksheets("一覧")
       ** Set FromRng = .Range(Range("A8"), Cells(Rows.Count, 33).End(xlUp))**
     End With

    Dim wb As Workbook
    Dim ToRange As Range
    
    Set wb = Workbooks.Open(Filename:=stTestFile)
    Set ToRange = wb.Worksheets("移動データー").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
       
    ToRange.Value = FromRng.Value
   
    Else
       MsgBox "転記するデーターはありません。"
          
     End If
    End If
    
     ThisWorkbook.Worksheets("一覧").Activate
      For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      　Cells(i, 31) = Replace(Cells(i, 31), "未", "済")
    　Next i

  　Sheets("一覧").Range("A7").AutoFilter 1
    ActiveSheet.ShowAllData
    
     Cells(Rows.Count, 1).End(xlUp).Select
     ActiveWindow.ScrollColumn = 7
    
    ActiveWorkbook.Save
    
    Workbooks("移動伝票.xlsx").Close
    
    Application.CutCopyMode = False
        
    Application.ScreenUpdating = True
 
 UserForm2.Show

End Sub

```

### 試したこと

VBA：フィルターで抽出したデーターを別ブックに貼り付け

エクセルで「契約情報」というブックに”契約情報”と”作成情報”というシートがあります。
”契約情報”シートで選んだ情報を”作成情報”シートに抽出して貼り付けるというところはできました。

これを”作成情報”シートへ抽出するのではなく、別の「書類作成」という別ブックの”作成情報”シートに抽出したいのですが、うまくいきません。

「契約情報」と「書類作成」ブックは同じフォルダーにあります。

現在のコードは次のとおりです。

Sub 抽出()

Worksheets("作成情報").Range("2:11").ClearContents

Dim ws1, Sakusei
Dim StartRow, EndRow, tmpRow

'シート名を変えてる場合は適宜変更
Set ws1 = Worksheets("契約情報")
Set ws2 = Worksheets("作成情報")
'作成情報シートに指定されている抽出条件
Sakusei = ws2.Cells(1, "N")

StartRow = 2
EndRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row
tmpRow = 2

For i = StartRow To EndRow
If (ws1.Cells(i, "M") = Sakusei) Then
ws2.Cells(tmpRow, "N") = Sakusei
ws2.Cells(tmpRow, "C") = ws1.Cells(i, "C")
ws2.Cells(tmpRow, "D") = ws1.Cells(i, "D")
ws2.Cells(tmpRow, "E") = ws1.Cells(i, "E")
ws2.Cells(tmpRow, "F") = ws1.Cells(i, "F")
ws2.Cells(tmpRow, "G") = ws1.Cells(i, "G")
ws2.Cells(tmpRow, "H") = ws1.Cells(i, "H")
ws2.Cells(tmpRow, "I") = ws1.Cells(i, "I")
ws2.Cells(tmpRow, "J") = ws1.Cells(i, "J")
ws2.Cells(tmpRow, "K") = ws1.Cells(i, "K")
tmpRow = tmpRow + 1
End If
Next

End Sub