Sub SHM_Distribution()
' declare variables for country codes
Dim sBelFrench As String
Dim sEnglish As String
Dim sFrench As String
Dim sGerman As String
Dim sHKEng As String
Dim sHKEngChinese As String
Dim sSpanish As String
Dim sItalian As String
' declare variables for languages. Will be used later for tab names
Dim sBelFrenLang As String
Dim sEngLang As String
Dim sFrenLang As String
Dim sGerLang As String
Dim sHKEngLang As String
Dim sHKEngChinLang As String
Dim sSpanLang As String
Dim sItalLang As String
Dim rRange As Range
Dim iCount As Integer
'Country codes
sBelFrench = "BE"
sEnglish = "AU,BM,BO,BS,CA,CN,CY,EG,GB,GG,IE,IL,IM,JE,JP,KW,KY,LB,LI,MY,NL,NO,OM,PK,PT,SA,SC,SG,TH,US,VG,VI,ZA,AE"
sFrench = "FR"
sGerman = "AT, CH, DE"
sHKEng = "TW"
sHKEngChinese = "HK"
sSpanish = "ES"
sItalian = "IT"
'Strings for tab names
sBelFrenLang = "Belgian French"
sEngLang = "English"
sFrenLang = "French"
sGerLang = "German"
sHKEngLang = "HK English"
sHKEngChinLang = "HK English Chinese"
sSpanLang = "Spanish"
sItalLang = "Italian"
'activate primary sheet
Sheets("Distribution").Select
' get total rows of active sheet
iCount = Application.COUNTA(Range("A:A"))
'call extract routine and pass country code and tab name strings
Call Extract(sBelFrench, sBelFrenLang, iCount)
Call Extract(sEnglish, sEngLang, iCount)
Call Extract(sFrench, sFrenLang, iCount)
Call Extract(sGerman, sGerLang, iCount)
Call Extract(sHKEng, sHKEngLang, iCount)
Call Extract(sHKEngChinese, sHKEngChinLang, iCount)
Call Extract(sSpanish, sSpanLang, iCount)
Call Extract(sItalian, sItalLang, iCount)
'turn off autofulter and deselect
Sheets("Distribution").AutoFilterMode = False
Application.CutCopyMode = False
End Sub
Sub Extract(sCode As String, sLang As String, iTotalRows As Integer)
' ary is an array string used by autofilter
' populate ary using passed country code value and separate each by a comma
ary = Split(sCode, ",")
'set range for autofilter
Set rRange = Range("H1:H" & iTotalRows)
With rRange
'turn on autofilter and select values of ary, in this case passed country code values from parent routine
.AutoFilter
.AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
End With
'get visible row count
iVisibleRows = (ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Count/ActiveSheet.AutoFilter.Range.Columns.Count) - 1
'if visible rows is zero then do not create a new sheet
If iVisibleRows <> 0 Then
'prep filtered data for copy
'select filtered area
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
'copy selection
Selection.Copy
'add new sheet using passed string value of language
Sheets.Add.Name = sLang
'activate new sheet
Sheets(sLang).Select
'paste selection to new sheet
ActiveSheet.Paste
'autofit columns
Sheets(sLang).Columns.AutoFit
'select primary distribution sheet for next run
Sheets("Distribution").Select
Else
Sheets("Distribution").Select
End If
End Sub
@ user3364233あなたはそれを通過しましたか? – user3598756
ありがとうございます。間違いなく、ループ内のすべてのステップが含まれており、明示的なオプションを覚えています。私はまもなく私の完全なルーチンを投稿します。さまざまな言語のカテゴリと国コードの数を考えると、コードには多くの繰り返しがあります。代わりに、変数が親ルーチンから渡されると、タブの作成やコピーの貼り付けなどの主要な作業を行うルーチンを呼び出します。入力をありがとう – user3364233
私は実際に自分の質問に答えた!昨日投稿した私の他の回答(ユーザーuser3364233)を参照してください。 Subの開始はSub SHM_Distribution()です。元の質問で自分の答えを更新する必要がありますか? – user3364233