vbaを使用してデータをコピーして1つのスプレッドシートから別のスプレッドシートにデータを並べ替える

Question

私はこのフォーラムを初めて使い、予算スプレッドシートからブックに情報を得るための助けが必要です。私が引っ張っているスプレッドシートには、複数の列と行にデータが広がっていて、空白のセルがたくさんありますが、空白のないブック内の行アイテム形式でレイアウトする必要があります。 私は各シートの各セルと行を手動でリンクすることができますが、多くのコードを必要とし、あまりエレガントではありません。 私は最良の選択肢は、列Bを介してループを実行し、そこに値がある場合、その行の値を持つすべてのセルを新しいシートにコピーすることだと思います。

これは、これまで私が持っているコードです：

Private Sub ImportBudget_Click() 
Dim BudgetBook As Workbook 
Dim filter As String 
Dim caption As String 
Dim BudgetFileName As String 
Dim ActiveBook As Workbook 
Dim targetWorkbook As Workbook 

Set targetWorkbook = Application.ActiveWorkbook 

' get the budget workbook 
filter = "Excel files (*.xlsx),*.xlsx" 
caption = "Please Select an input file " 
BudgetFileName = Application.GetOpenFilename(filter, , caption) 

Set BudgetBook = Application.Workbooks.Open(BudgetFileName) 

' copy data from budget to target workbook 
Dim targetSheet As Worksheet 
Set targetSheet = targetWorkbook.Worksheets(1) 
Dim sourceSheet As Worksheet 
Set sourceSheet = BudgetBook.Worksheets(1) 
Dim i As Integer 
Dim j As Integer 
    j = 2 
    For i = 2 To 300 
    If sourceSheet.Cells(i, 2).Value <> "" And sourceSheet.Cells(i, 1) <> "" Then 
    targetSheet.Cells(j, 1).Value = sourceSheet.Cells(i, 1).Value 
    targetSheet.Cells(j, 2).Value = sourceSheet.Cells(i, 2).Value 
    targetSheet.Cells(j, 3).Value = sourceSheet.Cells(i, 3).Value 
    j = j + 1 

    End If 
    Next i 

BudgetBook.Close 
End Sub 

これに伴う問題は、それが元のスプレッドシートの1セクションのためにうまく機能していることである、しかし、一部の地域では、データの最大9列を持っています行さらに、予算シートが別のセクションに分割されているため、セクションごとに同じコードを書き直して、iを新しい範囲に変更する必要がありますか？

Answer 1

sourceSheetと、列AまたはB（1または2）の値を持つ2〜300の任意の行がループし、1と最後の列の間のすべての列をデータでループします。その列範囲内の空白でないセルはすべて、新しい行のtargetSheetに配置され、列内のデータ間には空白が入りません。

Option Explicit 
Private Sub ImportBudget_Click() 
Dim BudgetBook As Workbook 
Dim filter As String 
Dim caption As String 
Dim BudgetFileName As String 
Dim ActiveBook As Workbook 
Dim targetWorkbook As Workbook 
Dim i as Single, k as Single, counter as Single 

Set targetWorkbook = Application.ActiveWorkbook 

' get the budget workbook 
filter = "Excel files (*.xlsx),*.xlsx" 
caption = "Please Select an input file " 
BudgetFileName = Application.GetOpenFilename(filter, , caption) 

Set BudgetBook = Application.Workbooks.Open(BudgetFileName) 

' copy data from budget to target workbook 
Dim targetSheet As Worksheet 
Set targetSheet = targetWorkbook.Worksheets(1) 
Dim sourceSheet As Worksheet 
Set sourceSheet = BudgetBook.Worksheets(1) 

j = 2 

With sourceSheet 
    For i = 2 To 300 
    If .Cells(i, 2).Value <> "" And .Cells(i, 1) <> "" Then 

     counter = 1 

     For k = 1 to .Cells(i,.Columns.Count).End(xlToLeft).Column 
      If .Cells(i,k) <> "" Then 
      targetSheet.Cells(j,counter) = .Cells(i,k) 
      counter = counter + 1 
      End if 
     Next k 
    j = j + 1 

    End If 
    Next i 
End With 

BudgetBook.Close 
End Sub 

Answer 2

あなただけの空白行をスキップしたい場合は、コピーされません数式または他の何かを持っている場合は、この

Set sourceRange = sourceSheet.UsedRange.SpecialCells(xlCellTypeConstants) 

Set sourceRange = Intersect(sourceRange.EntireRow, sourceRange.EntireColumn) 

sourceRange.Copy 

targetSheet.Paste 

のようなものは、私に知らせてください。